Line data Source code
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 Definition of the atomic potential types.
10 : !> \par History
11 : !> GT, 22.09.2002: added elp_potential_types
12 : !> \author Matthias Krack (04.07.2000)
13 : ! **************************************************************************************************
14 : MODULE external_potential_types
15 :
16 : USE ao_util, ONLY: exp_radius
17 : USE bibliography, ONLY: Goedecker1996,&
18 : Hartwigsen1998,&
19 : Krack2000,&
20 : Krack2005,&
21 : cite_reference
22 : USE cp_linked_list_input, ONLY: cp_sll_val_next,&
23 : cp_sll_val_type
24 : USE cp_parser_methods, ONLY: parser_get_next_line,&
25 : parser_get_object,&
26 : parser_search_string,&
27 : parser_test_next_token
28 : USE cp_parser_types, ONLY: cp_parser_type,&
29 : parser_create,&
30 : parser_release
31 : USE input_section_types, ONLY: section_vals_get,&
32 : section_vals_list_get,&
33 : section_vals_type,&
34 : section_vals_val_set
35 : USE input_val_types, ONLY: val_get,&
36 : val_type
37 : USE kinds, ONLY: default_path_length,&
38 : default_string_length,&
39 : dp
40 : USE mathconstants, ONLY: dfac,&
41 : fac,&
42 : fourpi,&
43 : pi,&
44 : rootpi
45 : USE mathlib, ONLY: symmetrize_matrix
46 : USE memory_utilities, ONLY: reallocate
47 : USE message_passing, ONLY: mp_para_env_type
48 : USE orbital_pointers, ONLY: co,&
49 : coset,&
50 : init_orbital_pointers,&
51 : nco,&
52 : ncoset,&
53 : nso
54 : USE orbital_transformation_matrices, ONLY: orbtramat
55 : USE periodic_table, ONLY: ptable
56 : USE string_utilities, ONLY: remove_word,&
57 : uppercase
58 : USE upf_local_integrals, ONLY: upf_local_type
59 : USE upf_projector_integrals, ONLY: upf_projector_init,&
60 : upf_projector_type
61 : USE upf_types, ONLY: atom_upfpot_type
62 : #include "../base/base_uses.f90"
63 :
64 : IMPLICIT NONE
65 :
66 : PRIVATE
67 :
68 : ! Global parameters
69 :
70 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'external_potential_types'
71 :
72 : ! Define the all-electron potential type
73 : ! Literature: M. Krack and M. Parrinello,
74 : ! Phys. Chem. Chem. Phys. 2, 2105 (2000)
75 : TYPE all_potential_type
76 : !MK PRIVATE
77 : CHARACTER(LEN=default_string_length) :: name = ""
78 : CHARACTER(LEN=default_string_length), &
79 : DIMENSION(2) :: description = ["All-electron potential ", &
80 : "Krack, Parrinello, PCCP 2, 2105 (2000)"]
81 : REAL(KIND=dp) :: alpha_core_charge = 0.0_dp, &
82 : ccore_charge = 0.0_dp, &
83 : core_charge_radius = 0.0_dp, &
84 : zeff = 0.0_dp, zeff_correction = 0.0_dp
85 : INTEGER :: z = 0
86 : INTEGER, DIMENSION(:), POINTER :: elec_conf => NULL()
87 : END TYPE all_potential_type
88 :
89 : ! Define the effective charge & inducible dipole potential type (for Fist)
90 : TYPE fist_potential_type
91 : PRIVATE
92 : CHARACTER(LEN=default_string_length) :: name = ""
93 : CHARACTER(LEN=default_string_length), &
94 : DIMENSION(1) :: description = "Effective charge and inducible dipole potential"
95 : REAL(KIND=dp) :: apol = 0.0_dp, cpol = 0.0_dp, mm_radius = 0.0_dp, qeff = 0.0_dp, &
96 : qmmm_corr_radius = 0.0_dp, qmmm_radius = 0.0_dp
97 :
98 : END TYPE fist_potential_type
99 :
100 : ! Local potential type
101 : ! V(r) = SUM_i exp(0.5*(r/rci)**2) * ( C1i + C2i (r/rci)**2 + C3i (r/rci)**4 ...)
102 : ! alpha = 0.5/rci**2
103 : TYPE local_potential_type
104 : !PRIVATE
105 : CHARACTER(LEN=default_string_length) :: name = ""
106 : CHARACTER(LEN=default_string_length), &
107 : DIMENSION(4) :: description = "Local short-range pseudopotential"
108 : INTEGER :: ngau = 0, npol = 0
109 : REAL(KIND=dp) :: radius = 0.0_dp
110 : REAL(KIND=dp), DIMENSION(:), POINTER :: alpha => NULL()
111 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: cval => NULL()
112 : END TYPE local_potential_type
113 :
114 : ! Define the GTH potential type
115 : ! Literature: - S. Goedecker, M. Teter and J. Hutter,
116 : ! Phys. Rev. B 54, 1703 (1996)
117 : ! - C. Hartwigsen, S. Goedecker and J. Hutter,
118 : ! Phys. Rev. B 58, 3641 (1998)
119 : ! - M. Krack,
120 : ! Theor. Chem. Acc. 114, 145 (2005)
121 : TYPE gth_potential_type
122 : CHARACTER(LEN=default_string_length) :: name = ""
123 : CHARACTER(LEN=default_string_length) :: aliases = ""
124 : CHARACTER(LEN=default_string_length), &
125 : DIMENSION(4) :: description = ["Goedecker-Teter-Hutter pseudopotential", &
126 : "Goedecker et al., PRB 54, 1703 (1996) ", &
127 : "Hartwigsen et al., PRB 58, 3641 (1998)", &
128 : "Krack, TCA 114, 145 (2005) "]
129 : REAL(KIND=dp) :: alpha_core_charge = 0.0_dp, &
130 : alpha_ppl = 0.0_dp, &
131 : ccore_charge = 0.0_dp, &
132 : cerf_ppl = 0.0_dp, &
133 : zeff = 0.0_dp, &
134 : core_charge_radius = 0.0_dp, &
135 : ppl_radius = 0.0_dp, &
136 : ppnl_radius = 0.0_dp, &
137 : zeff_correction = 0.0_dp
138 : INTEGER :: lppnl = 0, &
139 : lprj_ppnl_max = 0, &
140 : nexp_ppl = 0, &
141 : nppnl = 0, &
142 : nprj_ppnl_max = 0, z = 0
143 : REAL(KIND=dp), DIMENSION(:), POINTER :: alpha_ppnl => NULL(), &
144 : cexp_ppl => NULL()
145 : INTEGER, DIMENSION(:), POINTER :: elec_conf => NULL()
146 : ! Non-local projectors
147 : INTEGER, DIMENSION(:), POINTER :: nprj_ppnl => NULL()
148 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: cprj => NULL(), &
149 : cprj_ppnl => NULL(), &
150 : vprj_ppnl => NULL(), &
151 : wprj_ppnl => NULL()
152 : REAL(KIND=dp), DIMENSION(:, :, :), POINTER :: hprj_ppnl => NULL(), &
153 : kprj_ppnl => NULL()
154 : ! Type extensions
155 : ! Spin-orbit coupling (SOC) parameters
156 : LOGICAL :: soc = .FALSE.
157 : ! NLCC
158 : LOGICAL :: nlcc = .FALSE.
159 : INTEGER :: nexp_nlcc = 0
160 : REAL(KIND=dp), DIMENSION(:), POINTER :: alpha_nlcc => NULL()
161 : INTEGER, DIMENSION(:), POINTER :: nct_nlcc => NULL()
162 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: cval_nlcc => NULL()
163 : ! LSD potential
164 : LOGICAL :: lsdpot = .FALSE.
165 : INTEGER :: nexp_lsd = 0
166 : REAL(KIND=dp), DIMENSION(:), POINTER :: alpha_lsd => NULL()
167 : INTEGER, DIMENSION(:), POINTER :: nct_lsd => NULL()
168 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: cval_lsd => NULL()
169 : ! Extended local potential
170 : LOGICAL :: lpotextended = .FALSE.
171 : INTEGER :: nexp_lpot = 0
172 : REAL(KIND=dp), DIMENSION(:), POINTER :: alpha_lpot => NULL()
173 : INTEGER, DIMENSION(:), POINTER :: nct_lpot => NULL()
174 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: cval_lpot => NULL()
175 : ! monovalent pseudopotential
176 : LOGICAL :: monovalent = .FALSE.
177 : END TYPE gth_potential_type
178 :
179 : TYPE sgp_potential_type
180 : CHARACTER(LEN=default_string_length) :: name = ""
181 : CHARACTER(LEN=default_string_length) :: aliases = ""
182 : CHARACTER(LEN=default_string_length), &
183 : DIMENSION(4) :: description = ["Separable Gaussian pseudopotential ", &
184 : "M. Pelissier, N. Komiha, J.P. Daudey, JCC, 9, 298 (1988)", &
185 : "create from ", &
186 : " "]
187 : ! CHARGE
188 : INTEGER :: z = 0
189 : REAL(KIND=dp) :: zeff = 0.0_dp, &
190 : zeff_correction = 0.0_dp
191 : REAL(KIND=dp) :: alpha_core_charge = 0.0_dp, &
192 : ccore_charge = 0.0_dp, &
193 : core_charge_radius = 0.0_dp
194 : REAL(KIND=dp) :: ppl_radius = 0.0_dp, ppnl_radius = 0.0_dp
195 : INTEGER, DIMENSION(:), POINTER :: elec_conf => NULL()
196 : ! LOCAL
197 : LOGICAL :: ecp_local = .FALSE.
198 : INTEGER :: n_local = 0
199 : REAL(KIND=dp), DIMENSION(:), POINTER :: a_local => Null()
200 : REAL(KIND=dp), DIMENSION(:), POINTER :: c_local => Null()
201 : ! ECP local
202 : INTEGER :: nloc = 0 ! # terms
203 : INTEGER, DIMENSION(1:10) :: nrloc = 0 ! r**(n-2)
204 : REAL(dp), DIMENSION(1:10) :: aloc = 0.0_dp ! coefficient
205 : REAL(dp), DIMENSION(1:10) :: bloc = 0.0_dp ! exponent
206 : ! ECP semi-local
207 : LOGICAL :: ecp_semi_local = .FALSE.
208 : INTEGER :: sl_lmax = 0
209 : INTEGER, DIMENSION(0:10) :: npot = 0 ! # terms
210 : INTEGER, DIMENSION(1:15, 0:10) :: nrpot = 0 ! r**(n-2)
211 : REAL(dp), DIMENSION(1:15, 0:10) :: apot = 0.0_dp ! coefficient
212 : REAL(dp), DIMENSION(1:15, 0:10) :: bpot = 0.0_dp ! exponent
213 : ! NON-LOCAL
214 : INTEGER :: n_nonlocal = 0
215 : INTEGER :: nppnl = 0
216 : INTEGER :: lmax = -1
217 : LOGICAL, DIMENSION(0:5) :: is_nonlocal = .FALSE.
218 : REAL(KIND=dp), DIMENSION(:), POINTER :: a_nonlocal => Null()
219 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: h_nonlocal => Null()
220 : REAL(KIND=dp), DIMENSION(:, :, :), POINTER :: c_nonlocal => Null()
221 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: cprj_ppnl => NULL()
222 : REAL(KIND=dp), DIMENSION(:), POINTER :: vprj_ppnl => NULL()
223 : ! Original scalar UPF projectors and their immutable quadrature cache.
224 : TYPE(atom_upfpot_type), ALLOCATABLE :: upf_data
225 : TYPE(upf_projector_type) :: upf_projectors
226 : TYPE(upf_local_type) :: upf_local
227 : ! NLCC
228 : LOGICAL :: has_nlcc = .FALSE.
229 : INTEGER :: n_nlcc = 0
230 : REAL(KIND=dp), DIMENSION(:), POINTER :: a_nlcc => Null()
231 : REAL(KIND=dp), DIMENSION(:), POINTER :: c_nlcc => Null()
232 : END TYPE sgp_potential_type
233 :
234 : TYPE all_potential_p_type
235 : TYPE(all_potential_type), POINTER :: all_potential => NULL()
236 : END TYPE all_potential_p_type
237 :
238 : TYPE gth_potential_p_type
239 : TYPE(gth_potential_type), POINTER :: gth_potential => NULL()
240 : END TYPE gth_potential_p_type
241 :
242 : TYPE local_potential_p_type
243 : TYPE(local_potential_type), POINTER :: local_potential => NULL()
244 : END TYPE local_potential_p_type
245 :
246 : TYPE sgp_potential_p_type
247 : TYPE(sgp_potential_type), POINTER :: sgp_potential => NULL()
248 : END TYPE sgp_potential_p_type
249 :
250 : ! Public subroutines
251 : PUBLIC :: allocate_potential, &
252 : deallocate_potential, &
253 : get_potential, &
254 : init_potential, &
255 : read_potential, &
256 : set_potential, &
257 : set_default_all_potential, &
258 : write_potential, &
259 : copy_potential
260 :
261 : ! Public data types
262 :
263 : PUBLIC :: all_potential_type, &
264 : fist_potential_type, &
265 : local_potential_type, &
266 : gth_potential_type, &
267 : sgp_potential_type
268 : PUBLIC :: gth_potential_p_type, &
269 : sgp_potential_p_type
270 :
271 : INTERFACE allocate_potential
272 : MODULE PROCEDURE allocate_all_potential, &
273 : allocate_fist_potential, &
274 : allocate_local_potential, &
275 : allocate_gth_potential, &
276 : allocate_sgp_potential
277 : END INTERFACE
278 :
279 : INTERFACE deallocate_potential
280 : MODULE PROCEDURE deallocate_all_potential, &
281 : deallocate_fist_potential, &
282 : deallocate_local_potential, &
283 : deallocate_sgp_potential, &
284 : deallocate_gth_potential
285 : END INTERFACE
286 :
287 : INTERFACE get_potential
288 : MODULE PROCEDURE get_all_potential, &
289 : get_fist_potential, &
290 : get_local_potential, &
291 : get_gth_potential, &
292 : get_sgp_potential
293 : END INTERFACE
294 :
295 : INTERFACE init_potential
296 : MODULE PROCEDURE init_all_potential, &
297 : init_gth_potential, &
298 : init_sgp_potential
299 : END INTERFACE
300 :
301 : INTERFACE read_potential
302 : MODULE PROCEDURE read_all_potential, &
303 : read_all_potential_files, &
304 : read_local_potential, &
305 : read_local_potential_files, &
306 : read_gth_potential, &
307 : read_gth_potential_files
308 : END INTERFACE
309 :
310 : INTERFACE set_potential
311 : MODULE PROCEDURE set_all_potential, &
312 : set_fist_potential, &
313 : set_local_potential, &
314 : set_gth_potential, &
315 : set_sgp_potential
316 : END INTERFACE
317 :
318 : INTERFACE write_potential
319 : MODULE PROCEDURE write_all_potential, &
320 : write_local_potential, &
321 : write_gth_potential, &
322 : write_sgp_potential
323 : END INTERFACE
324 :
325 : INTERFACE copy_potential
326 : MODULE PROCEDURE copy_all_potential, &
327 : copy_gth_potential, &
328 : copy_sgp_potential
329 : END INTERFACE
330 :
331 : CONTAINS
332 :
333 : ! **************************************************************************************************
334 : !> \brief Abort after a potential could not be found in any requested library file.
335 : !> \param element_symbol ...
336 : !> \param potential_name ...
337 : !> \param potential_file_names ...
338 : ! **************************************************************************************************
339 0 : SUBROUTINE potential_files_not_found(element_symbol, potential_name, potential_file_names)
340 :
341 : CHARACTER(LEN=*), INTENT(IN) :: element_symbol, potential_name
342 : CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: potential_file_names
343 :
344 0 : CHARACTER(LEN=:), ALLOCATABLE :: file_list
345 : INTEGER :: i
346 :
347 0 : file_list = ""
348 0 : DO i = 1, SIZE(potential_file_names)
349 0 : file_list = TRIM(file_list)//"<"//TRIM(potential_file_names(i))//"> "
350 : END DO
351 : CALL cp_abort(__LOCATION__, &
352 : "The requested potential <"//TRIM(potential_name)// &
353 : "> for element <"//TRIM(element_symbol)// &
354 0 : "> was not found in the potential files "//TRIM(file_list))
355 :
356 0 : END SUBROUTINE potential_files_not_found
357 :
358 : ! **************************************************************************************************
359 : !> \brief Allocate an atomic all-electron potential data set.
360 : !> \param potential ...
361 : !> \date 25.07.2000,
362 : !> \author MK
363 : !> \version 1.0
364 : ! **************************************************************************************************
365 7016 : SUBROUTINE allocate_all_potential(potential)
366 : TYPE(all_potential_type), INTENT(INOUT), POINTER :: potential
367 :
368 7016 : IF (ASSOCIATED(potential)) CALL deallocate_potential(potential)
369 :
370 21048 : ALLOCATE (potential)
371 :
372 7016 : END SUBROUTINE allocate_all_potential
373 :
374 : ! **************************************************************************************************
375 : !> \brief Allocate an effective charge and inducible dipole potential data set.
376 : !> \param potential ...
377 : !> \date 05.03.2010
378 : !> \author Toon.Verstraelen@gmail.com
379 : ! **************************************************************************************************
380 11504 : SUBROUTINE allocate_fist_potential(potential)
381 : TYPE(fist_potential_type), INTENT(INOUT), POINTER :: potential
382 :
383 11504 : IF (ASSOCIATED(potential)) CALL deallocate_potential(potential)
384 :
385 23008 : ALLOCATE (potential)
386 :
387 11504 : END SUBROUTINE allocate_fist_potential
388 :
389 : ! **************************************************************************************************
390 : !> \brief Allocate an atomic local potential data set.
391 : !> \param potential ...
392 : !> \date 24.01.2014
393 : !> \author JGH
394 : !> \version 1.0
395 : ! **************************************************************************************************
396 24 : SUBROUTINE allocate_local_potential(potential)
397 : TYPE(local_potential_type), INTENT(INOUT), POINTER :: potential
398 :
399 24 : IF (ASSOCIATED(potential)) CALL deallocate_potential(potential)
400 :
401 120 : ALLOCATE (potential)
402 :
403 24 : END SUBROUTINE allocate_local_potential
404 :
405 : ! **************************************************************************************************
406 : !> \brief Allocate an atomic GTH potential data set.
407 : !> \param potential ...
408 : !> \date 25.07.2000
409 : !> \author MK
410 : !> \version 1.0
411 : ! **************************************************************************************************
412 10187 : SUBROUTINE allocate_gth_potential(potential)
413 : TYPE(gth_potential_type), INTENT(INOUT), POINTER :: potential
414 :
415 10187 : IF (ASSOCIATED(potential)) CALL deallocate_potential(potential)
416 :
417 50935 : ALLOCATE (potential)
418 :
419 10187 : END SUBROUTINE allocate_gth_potential
420 :
421 : ! **************************************************************************************************
422 : !> \brief Allocate an atomic SGP potential data set.
423 : !> \param potential ...
424 : !> \version 1.0
425 : ! **************************************************************************************************
426 110 : SUBROUTINE allocate_sgp_potential(potential)
427 : TYPE(sgp_potential_type), INTENT(INOUT), POINTER :: potential
428 :
429 110 : IF (ASSOCIATED(potential)) CALL deallocate_potential(potential)
430 :
431 64350 : ALLOCATE (potential)
432 :
433 110 : END SUBROUTINE allocate_sgp_potential
434 : ! **************************************************************************************************
435 : !> \brief Deallocate an atomic all-electron potential data set.
436 : !> \param potential ...
437 : !> \date 03.11.2000
438 : !> \author MK
439 : !> \version 1.0
440 : ! **************************************************************************************************
441 7014 : SUBROUTINE deallocate_all_potential(potential)
442 : TYPE(all_potential_type), POINTER :: potential
443 :
444 7014 : IF (.NOT. ASSOCIATED(potential)) THEN
445 0 : CPABORT("The pointer potential is not associated.")
446 : END IF
447 :
448 7014 : DEALLOCATE (potential%elec_conf)
449 7014 : DEALLOCATE (potential)
450 :
451 7014 : END SUBROUTINE deallocate_all_potential
452 :
453 : ! **************************************************************************************************
454 : !> \brief Deallocate an effective charge and inducible dipole potential data set.
455 : !> \param potential ...
456 : !> \date 05.03.2010
457 : !> \author Toon.Verstraelen@gmail.com
458 : ! **************************************************************************************************
459 11504 : SUBROUTINE deallocate_fist_potential(potential)
460 : TYPE(fist_potential_type), POINTER :: potential
461 :
462 11504 : IF (.NOT. ASSOCIATED(potential)) THEN
463 0 : CPABORT("The pointer potential is not associated.")
464 : END IF
465 :
466 : ! Nothing exciting here yet.
467 11504 : DEALLOCATE (potential)
468 :
469 11504 : END SUBROUTINE deallocate_fist_potential
470 :
471 : ! **************************************************************************************************
472 : !> \brief Deallocate an atomic local potential data set.
473 : !> \param potential ...
474 : !> \date 24.01.2014
475 : !> \author JGH
476 : !> \version 1.0
477 : ! **************************************************************************************************
478 24 : SUBROUTINE deallocate_local_potential(potential)
479 : TYPE(local_potential_type), POINTER :: potential
480 :
481 24 : IF (.NOT. ASSOCIATED(potential)) THEN
482 0 : CPABORT("The pointer potential is not associated.")
483 : END IF
484 :
485 24 : IF (ASSOCIATED(potential%alpha)) THEN
486 24 : DEALLOCATE (potential%alpha)
487 : END IF
488 24 : IF (ASSOCIATED(potential%cval)) THEN
489 24 : DEALLOCATE (potential%cval)
490 : END IF
491 :
492 24 : DEALLOCATE (potential)
493 :
494 24 : END SUBROUTINE deallocate_local_potential
495 :
496 : ! **************************************************************************************************
497 : !> \brief Deallocate an atomic GTH potential data set.
498 : !> \param potential ...
499 : !> \date 03.11.2000
500 : !> \author MK
501 : !> \version 1.0
502 : ! **************************************************************************************************
503 10185 : SUBROUTINE deallocate_gth_potential(potential)
504 : TYPE(gth_potential_type), POINTER :: potential
505 :
506 10185 : IF (.NOT. ASSOCIATED(potential)) THEN
507 0 : CPABORT("The pointer potential is not associated.")
508 : END IF
509 :
510 10185 : DEALLOCATE (potential%elec_conf)
511 : ! Deallocate the parameters of the local part
512 :
513 10185 : IF (ASSOCIATED(potential%cexp_ppl)) THEN
514 10185 : DEALLOCATE (potential%cexp_ppl)
515 : END IF
516 :
517 : ! Deallocate the parameters of the non-local part
518 10185 : IF (ASSOCIATED(potential%alpha_ppnl)) THEN
519 5139 : DEALLOCATE (potential%alpha_ppnl)
520 5139 : DEALLOCATE (potential%cprj)
521 5139 : DEALLOCATE (potential%cprj_ppnl)
522 5139 : DEALLOCATE (potential%hprj_ppnl)
523 5139 : DEALLOCATE (potential%kprj_ppnl)
524 5139 : DEALLOCATE (potential%nprj_ppnl)
525 5139 : DEALLOCATE (potential%vprj_ppnl)
526 5139 : DEALLOCATE (potential%wprj_ppnl)
527 : END IF
528 :
529 10185 : IF (ASSOCIATED(potential%alpha_lpot)) THEN
530 8 : DEALLOCATE (potential%alpha_lpot)
531 8 : DEALLOCATE (potential%nct_lpot)
532 8 : DEALLOCATE (potential%cval_lpot)
533 : END IF
534 :
535 10185 : IF (ASSOCIATED(potential%alpha_lsd)) THEN
536 0 : DEALLOCATE (potential%alpha_lsd)
537 0 : DEALLOCATE (potential%nct_lsd)
538 0 : DEALLOCATE (potential%cval_lsd)
539 : END IF
540 :
541 10185 : IF (ASSOCIATED(potential%alpha_nlcc)) THEN
542 68 : DEALLOCATE (potential%alpha_nlcc)
543 68 : DEALLOCATE (potential%nct_nlcc)
544 68 : DEALLOCATE (potential%cval_nlcc)
545 : END IF
546 :
547 10185 : DEALLOCATE (potential)
548 :
549 10185 : END SUBROUTINE deallocate_gth_potential
550 :
551 : ! **************************************************************************************************
552 : !> \brief Deallocate an atomic SGP potential data set.
553 : !> \param potential ...
554 : ! **************************************************************************************************
555 110 : SUBROUTINE deallocate_sgp_potential(potential)
556 : TYPE(sgp_potential_type), POINTER :: potential
557 :
558 110 : IF (.NOT. ASSOCIATED(potential)) THEN
559 0 : CPABORT("The pointer potential is not associated.")
560 : END IF
561 :
562 110 : IF (ASSOCIATED(potential%elec_conf)) THEN
563 108 : DEALLOCATE (potential%elec_conf)
564 : END IF
565 110 : IF (ASSOCIATED(potential%a_local)) THEN
566 26 : DEALLOCATE (potential%a_local)
567 : END IF
568 110 : IF (ASSOCIATED(potential%c_local)) THEN
569 26 : DEALLOCATE (potential%c_local)
570 : END IF
571 :
572 110 : IF (ASSOCIATED(potential%a_nonlocal)) THEN
573 14 : DEALLOCATE (potential%a_nonlocal)
574 : END IF
575 110 : IF (ASSOCIATED(potential%h_nonlocal)) THEN
576 16 : DEALLOCATE (potential%h_nonlocal)
577 : END IF
578 110 : IF (ASSOCIATED(potential%c_nonlocal)) THEN
579 16 : DEALLOCATE (potential%c_nonlocal)
580 : END IF
581 110 : IF (ASSOCIATED(potential%cprj_ppnl)) THEN
582 2 : DEALLOCATE (potential%cprj_ppnl)
583 : END IF
584 110 : IF (ASSOCIATED(potential%vprj_ppnl)) THEN
585 2 : DEALLOCATE (potential%vprj_ppnl)
586 : END IF
587 :
588 110 : IF (ASSOCIATED(potential%a_nlcc)) THEN
589 6 : DEALLOCATE (potential%a_nlcc)
590 : END IF
591 110 : IF (ASSOCIATED(potential%c_nlcc)) THEN
592 6 : DEALLOCATE (potential%c_nlcc)
593 : END IF
594 :
595 110 : DEALLOCATE (potential)
596 :
597 110 : END SUBROUTINE deallocate_sgp_potential
598 :
599 : ! **************************************************************************************************
600 : !> \brief Get attributes of an all-electron potential data set.
601 : !> \param potential ...
602 : !> \param name ...
603 : !> \param alpha_core_charge ...
604 : !> \param ccore_charge ...
605 : !> \param core_charge_radius ...
606 : !> \param z ...
607 : !> \param zeff ...
608 : !> \param zeff_correction ...
609 : !> \param elec_conf ...
610 : !> \date 11.01.2002
611 : !> \author MK
612 : !> \version 1.0
613 : ! **************************************************************************************************
614 340454 : SUBROUTINE get_all_potential(potential, name, alpha_core_charge, &
615 : ccore_charge, core_charge_radius, z, zeff, &
616 : zeff_correction, elec_conf)
617 : TYPE(all_potential_type), INTENT(IN) :: potential
618 : CHARACTER(LEN=default_string_length), &
619 : INTENT(OUT), OPTIONAL :: name
620 : REAL(KIND=dp), INTENT(OUT), OPTIONAL :: alpha_core_charge, ccore_charge, &
621 : core_charge_radius
622 : INTEGER, INTENT(OUT), OPTIONAL :: z
623 : REAL(KIND=dp), INTENT(OUT), OPTIONAL :: zeff, zeff_correction
624 : INTEGER, DIMENSION(:), OPTIONAL, POINTER :: elec_conf
625 :
626 340454 : IF (PRESENT(name)) name = potential%name
627 340454 : IF (PRESENT(alpha_core_charge)) THEN
628 79372 : alpha_core_charge = potential%alpha_core_charge
629 : END IF
630 340454 : IF (PRESENT(ccore_charge)) ccore_charge = potential%ccore_charge
631 340454 : IF (PRESENT(core_charge_radius)) THEN
632 91739 : core_charge_radius = potential%core_charge_radius
633 : END IF
634 340454 : IF (PRESENT(z)) z = potential%z
635 340454 : IF (PRESENT(zeff)) zeff = potential%zeff
636 340454 : IF (PRESENT(zeff_correction)) zeff_correction = potential%zeff_correction
637 340454 : IF (PRESENT(elec_conf)) elec_conf => potential%elec_conf
638 :
639 340454 : END SUBROUTINE get_all_potential
640 :
641 : ! **************************************************************************************************
642 : !> \brief Get attributes of an effective point charge and inducible dipole
643 : !> potential.
644 : !> \param potential ...
645 : !> \param name ...
646 : !> \param apol ...
647 : !> \param cpol ...
648 : !> \param mm_radius ...
649 : !> \param qeff ...
650 : !> \param qmmm_corr_radius ...
651 : !> \param qmmm_radius ...
652 : !> \date 05.03-2010
653 : !> \author Toon.Verstraelen@UGent.be
654 : ! **************************************************************************************************
655 56212845 : ELEMENTAL SUBROUTINE get_fist_potential(potential, name, apol, cpol, mm_radius, qeff, &
656 : qmmm_corr_radius, qmmm_radius)
657 : TYPE(fist_potential_type), INTENT(IN) :: potential
658 : CHARACTER(LEN=default_string_length), &
659 : INTENT(OUT), OPTIONAL :: name
660 : REAL(KIND=dp), INTENT(OUT), OPTIONAL :: apol, cpol, mm_radius, qeff, &
661 : qmmm_corr_radius, qmmm_radius
662 :
663 56212845 : IF (PRESENT(name)) name = potential%name
664 56212845 : IF (PRESENT(apol)) apol = potential%apol
665 56212845 : IF (PRESENT(cpol)) cpol = potential%cpol
666 56212845 : IF (PRESENT(mm_radius)) mm_radius = potential%mm_radius
667 56212845 : IF (PRESENT(qeff)) qeff = potential%qeff
668 56212845 : IF (PRESENT(qmmm_corr_radius)) qmmm_corr_radius = potential%qmmm_corr_radius
669 56212845 : IF (PRESENT(qmmm_radius)) qmmm_radius = potential%qmmm_radius
670 :
671 56212845 : END SUBROUTINE get_fist_potential
672 :
673 : ! **************************************************************************************************
674 : !> \brief Get attributes of an atomic local potential data set.
675 : !> \param potential ...
676 : !> \param name ...
677 : !> \param ngau ...
678 : !> \param npol ...
679 : !> \param alpha ...
680 : !> \param cval ...
681 : !> \param radius ...
682 : !> \date 24.01.2014
683 : !> \author JGH
684 : !> \version 1.0
685 : ! **************************************************************************************************
686 445 : SUBROUTINE get_local_potential(potential, name, ngau, npol, alpha, cval, radius)
687 : TYPE(local_potential_type), INTENT(IN) :: potential
688 : CHARACTER(LEN=default_string_length), &
689 : INTENT(OUT), OPTIONAL :: name
690 : INTEGER, INTENT(OUT), OPTIONAL :: ngau, npol
691 : REAL(KIND=dp), DIMENSION(:), OPTIONAL, POINTER :: alpha
692 : REAL(KIND=dp), DIMENSION(:, :), OPTIONAL, POINTER :: cval
693 : REAL(KIND=dp), INTENT(OUT), OPTIONAL :: radius
694 :
695 445 : IF (PRESENT(name)) name = potential%name
696 445 : IF (PRESENT(ngau)) ngau = potential%ngau
697 445 : IF (PRESENT(npol)) npol = potential%npol
698 445 : IF (PRESENT(alpha)) alpha => potential%alpha
699 445 : IF (PRESENT(cval)) cval => potential%cval
700 445 : IF (PRESENT(radius)) radius = potential%radius
701 :
702 445 : END SUBROUTINE get_local_potential
703 :
704 : ! **************************************************************************************************
705 : !> \brief Get attributes of a GTH potential data set.
706 : !> \param potential ...
707 : !> \param name ...
708 : !> \param aliases ...
709 : !> \param alpha_core_charge ...
710 : !> \param alpha_ppl ...
711 : !> \param ccore_charge ...
712 : !> \param cerf_ppl ...
713 : !> \param core_charge_radius ...
714 : !> \param ppl_radius ...
715 : !> \param ppnl_radius ...
716 : !> \param lppnl ...
717 : !> \param lprj_ppnl_max ...
718 : !> \param nexp_ppl ...
719 : !> \param nppnl ...
720 : !> \param nprj_ppnl_max ...
721 : !> \param z ...
722 : !> \param zeff ...
723 : !> \param zeff_correction ...
724 : !> \param ppl_present ...
725 : !> \param ppnl_present ...
726 : !> \param soc_present ...
727 : !> \param alpha_ppnl ...
728 : !> \param cexp_ppl ...
729 : !> \param elec_conf ...
730 : !> \param nprj_ppnl ...
731 : !> \param cprj ...
732 : !> \param cprj_ppnl ...
733 : !> \param vprj_ppnl ...
734 : !> \param wprj_ppnl ...
735 : !> \param hprj_ppnl ...
736 : !> \param kprj_ppnl ...
737 : !> \param lpot_present ...
738 : !> \param nexp_lpot ...
739 : !> \param alpha_lpot ...
740 : !> \param nct_lpot ...
741 : !> \param cval_lpot ...
742 : !> \param lsd_present ...
743 : !> \param nexp_lsd ...
744 : !> \param alpha_lsd ...
745 : !> \param nct_lsd ...
746 : !> \param cval_lsd ...
747 : !> \param nlcc_present ...
748 : !> \param nexp_nlcc ...
749 : !> \param alpha_nlcc ...
750 : !> \param nct_nlcc ...
751 : !> \param cval_nlcc ...
752 : !> \param monovalent ...
753 : !> \date 11.01.2002
754 : !> \author MK
755 : !> \version 1.0
756 : ! **************************************************************************************************
757 5455453 : SUBROUTINE get_gth_potential(potential, name, aliases, alpha_core_charge, &
758 : alpha_ppl, ccore_charge, cerf_ppl, &
759 : core_charge_radius, ppl_radius, ppnl_radius, &
760 : lppnl, lprj_ppnl_max, nexp_ppl, nppnl, &
761 : nprj_ppnl_max, z, zeff, zeff_correction, &
762 : ppl_present, ppnl_present, soc_present, &
763 : alpha_ppnl, cexp_ppl, elec_conf, nprj_ppnl, cprj, &
764 : cprj_ppnl, vprj_ppnl, wprj_ppnl, hprj_ppnl, kprj_ppnl, &
765 : lpot_present, nexp_lpot, alpha_lpot, nct_lpot, cval_lpot, &
766 : lsd_present, nexp_lsd, alpha_lsd, nct_lsd, cval_lsd, &
767 : nlcc_present, nexp_nlcc, alpha_nlcc, nct_nlcc, cval_nlcc, &
768 : monovalent)
769 :
770 : TYPE(gth_potential_type), INTENT(IN) :: potential
771 : CHARACTER(LEN=default_string_length), &
772 : INTENT(OUT), OPTIONAL :: name, aliases
773 : REAL(KIND=dp), INTENT(OUT), OPTIONAL :: alpha_core_charge, alpha_ppl, &
774 : ccore_charge, cerf_ppl, &
775 : core_charge_radius, ppl_radius, &
776 : ppnl_radius
777 : INTEGER, INTENT(OUT), OPTIONAL :: lppnl, lprj_ppnl_max, nexp_ppl, nppnl, &
778 : nprj_ppnl_max, z
779 : REAL(KIND=dp), INTENT(OUT), OPTIONAL :: zeff, zeff_correction
780 : LOGICAL, INTENT(OUT), OPTIONAL :: ppl_present, ppnl_present, soc_present
781 : REAL(KIND=dp), DIMENSION(:), OPTIONAL, POINTER :: alpha_ppnl, cexp_ppl
782 : INTEGER, DIMENSION(:), OPTIONAL, POINTER :: elec_conf, nprj_ppnl
783 : REAL(KIND=dp), DIMENSION(:, :), OPTIONAL, POINTER :: cprj, cprj_ppnl, vprj_ppnl, wprj_ppnl
784 : REAL(KIND=dp), DIMENSION(:, :, :), OPTIONAL, &
785 : POINTER :: hprj_ppnl, kprj_ppnl
786 : LOGICAL, INTENT(OUT), OPTIONAL :: lpot_present
787 : INTEGER, INTENT(OUT), OPTIONAL :: nexp_lpot
788 : REAL(KIND=dp), DIMENSION(:), OPTIONAL, POINTER :: alpha_lpot
789 : INTEGER, DIMENSION(:), OPTIONAL, POINTER :: nct_lpot
790 : REAL(KIND=dp), DIMENSION(:, :), OPTIONAL, POINTER :: cval_lpot
791 : LOGICAL, INTENT(OUT), OPTIONAL :: lsd_present
792 : INTEGER, INTENT(OUT), OPTIONAL :: nexp_lsd
793 : REAL(KIND=dp), DIMENSION(:), OPTIONAL, POINTER :: alpha_lsd
794 : INTEGER, DIMENSION(:), OPTIONAL, POINTER :: nct_lsd
795 : REAL(KIND=dp), DIMENSION(:, :), OPTIONAL, POINTER :: cval_lsd
796 : LOGICAL, INTENT(OUT), OPTIONAL :: nlcc_present
797 : INTEGER, INTENT(OUT), OPTIONAL :: nexp_nlcc
798 : REAL(KIND=dp), DIMENSION(:), OPTIONAL, POINTER :: alpha_nlcc
799 : INTEGER, DIMENSION(:), OPTIONAL, POINTER :: nct_nlcc
800 : REAL(KIND=dp), DIMENSION(:, :), OPTIONAL, POINTER :: cval_nlcc
801 : LOGICAL, INTENT(OUT), OPTIONAL :: monovalent
802 :
803 5455453 : IF (PRESENT(name)) name = potential%name
804 5455453 : IF (PRESENT(aliases)) aliases = potential%aliases
805 5455453 : IF (PRESENT(alpha_core_charge)) THEN
806 207413 : alpha_core_charge = potential%alpha_core_charge
807 : END IF
808 5455453 : IF (PRESENT(alpha_ppl)) alpha_ppl = potential%alpha_ppl
809 5455453 : IF (PRESENT(ccore_charge)) ccore_charge = potential%ccore_charge
810 5455453 : IF (PRESENT(cerf_ppl)) cerf_ppl = potential%cerf_ppl
811 5455453 : IF (PRESENT(core_charge_radius)) THEN
812 57919 : core_charge_radius = potential%core_charge_radius
813 : END IF
814 5455453 : IF (PRESENT(ppl_radius)) ppl_radius = potential%ppl_radius
815 5455453 : IF (PRESENT(ppnl_radius)) ppnl_radius = potential%ppnl_radius
816 5455453 : IF (PRESENT(soc_present)) soc_present = potential%soc
817 5455453 : IF (PRESENT(lppnl)) lppnl = potential%lppnl
818 5455453 : IF (PRESENT(lprj_ppnl_max)) lprj_ppnl_max = potential%lprj_ppnl_max
819 5455453 : IF (PRESENT(nexp_ppl)) nexp_ppl = potential%nexp_ppl
820 5455453 : IF (PRESENT(nppnl)) nppnl = potential%nppnl
821 5455453 : IF (PRESENT(nprj_ppnl_max)) nprj_ppnl_max = potential%nprj_ppnl_max
822 5455453 : IF (PRESENT(z)) z = potential%z
823 5455453 : IF (PRESENT(zeff)) zeff = potential%zeff
824 5455453 : IF (PRESENT(zeff_correction)) zeff_correction = potential%zeff_correction
825 5455453 : IF (PRESENT(ppl_present)) ppl_present = (potential%nexp_ppl > 0)
826 5455453 : IF (PRESENT(ppnl_present)) ppnl_present = (potential%nppnl > 0)
827 5455453 : IF (PRESENT(alpha_ppnl)) alpha_ppnl => potential%alpha_ppnl
828 5455453 : IF (PRESENT(cexp_ppl)) cexp_ppl => potential%cexp_ppl
829 5455453 : IF (PRESENT(elec_conf)) elec_conf => potential%elec_conf
830 5455453 : IF (PRESENT(nprj_ppnl)) nprj_ppnl => potential%nprj_ppnl
831 5455453 : IF (PRESENT(cprj)) cprj => potential%cprj
832 5455453 : IF (PRESENT(cprj_ppnl)) cprj_ppnl => potential%cprj_ppnl
833 5455453 : IF (PRESENT(hprj_ppnl)) hprj_ppnl => potential%hprj_ppnl
834 5455453 : IF (PRESENT(kprj_ppnl)) kprj_ppnl => potential%kprj_ppnl
835 5455453 : IF (PRESENT(vprj_ppnl)) vprj_ppnl => potential%vprj_ppnl
836 5455453 : IF (PRESENT(wprj_ppnl)) wprj_ppnl => potential%wprj_ppnl
837 :
838 5455453 : IF (PRESENT(lpot_present)) lpot_present = potential%lpotextended
839 5455453 : IF (PRESENT(nexp_lpot)) nexp_lpot = potential%nexp_lpot
840 5455453 : IF (PRESENT(alpha_lpot)) alpha_lpot => potential%alpha_lpot
841 5455453 : IF (PRESENT(nct_lpot)) nct_lpot => potential%nct_lpot
842 5455453 : IF (PRESENT(cval_lpot)) cval_lpot => potential%cval_lpot
843 :
844 5455453 : IF (PRESENT(lsd_present)) lsd_present = potential%lsdpot
845 5455453 : IF (PRESENT(nexp_lsd)) nexp_lsd = potential%nexp_lsd
846 5455453 : IF (PRESENT(alpha_lsd)) alpha_lsd => potential%alpha_lsd
847 5455453 : IF (PRESENT(nct_lsd)) nct_lsd => potential%nct_lsd
848 5455453 : IF (PRESENT(cval_lsd)) cval_lsd => potential%cval_lsd
849 :
850 5455453 : IF (PRESENT(nlcc_present)) nlcc_present = potential%nlcc
851 5455453 : IF (PRESENT(nexp_nlcc)) nexp_nlcc = potential%nexp_nlcc
852 5455453 : IF (PRESENT(alpha_nlcc)) alpha_nlcc => potential%alpha_nlcc
853 5455453 : IF (PRESENT(nct_nlcc)) nct_nlcc => potential%nct_nlcc
854 5455453 : IF (PRESENT(cval_nlcc)) cval_nlcc => potential%cval_nlcc
855 :
856 5455453 : IF (PRESENT(monovalent)) monovalent = potential%monovalent
857 :
858 5455453 : END SUBROUTINE get_gth_potential
859 :
860 : ! **************************************************************************************************
861 : !> \brief ...
862 : !> \param potential ...
863 : !> \param name ...
864 : !> \param description ...
865 : !> \param aliases ...
866 : !> \param elec_conf ...
867 : !> \param z ...
868 : !> \param zeff ...
869 : !> \param zeff_correction ...
870 : !> \param alpha_core_charge ...
871 : !> \param ccore_charge ...
872 : !> \param core_charge_radius ...
873 : !> \param ppl_radius ...
874 : !> \param ppnl_radius ...
875 : !> \param ppl_present ...
876 : !> \param ppnl_present ...
877 : !> \param ppsl_present ...
878 : !> \param ecp_local ...
879 : !> \param n_local ...
880 : !> \param a_local ...
881 : !> \param c_local ...
882 : !> \param nloc ...
883 : !> \param nrloc ...
884 : !> \param aloc ...
885 : !> \param bloc ...
886 : !> \param ecp_semi_local ...
887 : !> \param sl_lmax ...
888 : !> \param npot ...
889 : !> \param nrpot ...
890 : !> \param apot ...
891 : !> \param bpot ...
892 : !> \param n_nonlocal ...
893 : !> \param nppnl ...
894 : !> \param lmax ...
895 : !> \param is_nonlocal ...
896 : !> \param a_nonlocal ...
897 : !> \param h_nonlocal ...
898 : !> \param c_nonlocal ...
899 : !> \param cprj_ppnl ...
900 : !> \param vprj_ppnl ...
901 : !> \param has_nlcc ...
902 : !> \param n_nlcc ...
903 : !> \param a_nlcc ...
904 : !> \param c_nlcc ...
905 : ! **************************************************************************************************
906 34218 : SUBROUTINE get_sgp_potential(potential, name, description, aliases, elec_conf, &
907 : z, zeff, zeff_correction, alpha_core_charge, &
908 : ccore_charge, core_charge_radius, &
909 : ppl_radius, ppnl_radius, ppl_present, ppnl_present, ppsl_present, &
910 : ecp_local, n_local, a_local, c_local, &
911 : nloc, nrloc, aloc, bloc, &
912 : ecp_semi_local, sl_lmax, npot, nrpot, apot, bpot, &
913 : n_nonlocal, nppnl, lmax, is_nonlocal, a_nonlocal, h_nonlocal, c_nonlocal, &
914 : cprj_ppnl, vprj_ppnl, has_nlcc, n_nlcc, a_nlcc, c_nlcc)
915 :
916 : TYPE(sgp_potential_type), INTENT(IN) :: potential
917 : CHARACTER(LEN=default_string_length), &
918 : INTENT(OUT), OPTIONAL :: name
919 : CHARACTER(LEN=default_string_length), &
920 : DIMENSION(4), INTENT(OUT), OPTIONAL :: description
921 : CHARACTER(LEN=default_string_length), &
922 : INTENT(OUT), OPTIONAL :: aliases
923 : INTEGER, DIMENSION(:), OPTIONAL, POINTER :: elec_conf
924 : INTEGER, INTENT(OUT), OPTIONAL :: z
925 : REAL(KIND=dp), INTENT(OUT), OPTIONAL :: zeff, zeff_correction, &
926 : alpha_core_charge, ccore_charge, &
927 : core_charge_radius, ppl_radius, &
928 : ppnl_radius
929 : LOGICAL, INTENT(OUT), OPTIONAL :: ppl_present, ppnl_present, ppsl_present, &
930 : ecp_local
931 : INTEGER, INTENT(OUT), OPTIONAL :: n_local
932 : REAL(KIND=dp), DIMENSION(:), OPTIONAL, POINTER :: a_local, c_local
933 : INTEGER, INTENT(OUT), OPTIONAL :: nloc
934 : INTEGER, DIMENSION(1:10), INTENT(OUT), OPTIONAL :: nrloc
935 : REAL(dp), DIMENSION(1:10), INTENT(OUT), OPTIONAL :: aloc, bloc
936 : LOGICAL, INTENT(OUT), OPTIONAL :: ecp_semi_local
937 : INTEGER, INTENT(OUT), OPTIONAL :: sl_lmax
938 : INTEGER, DIMENSION(0:10), OPTIONAL :: npot
939 : INTEGER, DIMENSION(1:15, 0:10), OPTIONAL :: nrpot
940 : REAL(dp), DIMENSION(1:15, 0:10), OPTIONAL :: apot, bpot
941 : INTEGER, INTENT(OUT), OPTIONAL :: n_nonlocal, nppnl, lmax
942 : LOGICAL, DIMENSION(0:5), OPTIONAL :: is_nonlocal
943 : REAL(KIND=dp), DIMENSION(:), OPTIONAL, POINTER :: a_nonlocal
944 : REAL(KIND=dp), DIMENSION(:, :), OPTIONAL, POINTER :: h_nonlocal
945 : REAL(KIND=dp), DIMENSION(:, :, :), OPTIONAL, &
946 : POINTER :: c_nonlocal
947 : REAL(KIND=dp), DIMENSION(:, :), OPTIONAL, POINTER :: cprj_ppnl
948 : REAL(KIND=dp), DIMENSION(:), OPTIONAL, POINTER :: vprj_ppnl
949 : LOGICAL, INTENT(OUT), OPTIONAL :: has_nlcc
950 : INTEGER, INTENT(OUT), OPTIONAL :: n_nlcc
951 : REAL(KIND=dp), DIMENSION(:), OPTIONAL, POINTER :: a_nlcc, c_nlcc
952 :
953 34218 : IF (PRESENT(name)) name = potential%name
954 34218 : IF (PRESENT(aliases)) aliases = potential%aliases
955 34748 : IF (PRESENT(description)) description = potential%description
956 :
957 34218 : IF (PRESENT(elec_conf)) elec_conf => potential%elec_conf
958 :
959 34218 : IF (PRESENT(z)) z = potential%z
960 34218 : IF (PRESENT(zeff)) zeff = potential%zeff
961 34218 : IF (PRESENT(zeff_correction)) zeff_correction = potential%zeff_correction
962 34218 : IF (PRESENT(alpha_core_charge)) alpha_core_charge = potential%alpha_core_charge
963 34218 : IF (PRESENT(ccore_charge)) ccore_charge = potential%ccore_charge
964 34218 : IF (PRESENT(core_charge_radius)) core_charge_radius = potential%core_charge_radius
965 :
966 34218 : IF (PRESENT(ppl_radius)) ppl_radius = potential%ppl_radius
967 34218 : IF (PRESENT(ppnl_radius)) ppnl_radius = potential%ppnl_radius
968 34218 : IF (PRESENT(ppl_present)) THEN
969 162 : ppl_present = (potential%nloc > 0 .OR. potential%n_local > 0)
970 : END IF
971 34218 : IF (PRESENT(ppnl_present)) THEN
972 1062 : ppnl_present = ANY(potential%is_nonlocal)
973 : END IF
974 34218 : IF (PRESENT(ppsl_present)) THEN
975 0 : ppsl_present = potential%ecp_semi_local
976 : END IF
977 :
978 34218 : IF (PRESENT(ecp_local)) ecp_local = potential%ecp_local
979 34218 : IF (PRESENT(n_local)) n_local = potential%n_local
980 34218 : IF (PRESENT(a_local)) a_local => potential%a_local
981 34218 : IF (PRESENT(c_local)) c_local => potential%c_local
982 :
983 34218 : IF (PRESENT(nloc)) nloc = potential%nloc
984 91253 : IF (PRESENT(nrloc)) nrloc = potential%nrloc
985 86930 : IF (PRESENT(aloc)) aloc = potential%aloc
986 86930 : IF (PRESENT(bloc)) bloc = potential%bloc
987 :
988 34218 : IF (PRESENT(ecp_semi_local)) ecp_semi_local = potential%ecp_semi_local
989 34218 : IF (PRESENT(sl_lmax)) sl_lmax = potential%sl_lmax
990 91794 : IF (PRESENT(npot)) npot = potential%npot
991 939219 : IF (PRESENT(nrpot)) nrpot = potential%nrpot
992 882402 : IF (PRESENT(apot)) apot = potential%apot
993 882402 : IF (PRESENT(bpot)) bpot = potential%bpot
994 :
995 34218 : IF (PRESENT(n_nonlocal)) n_nonlocal = potential%n_nonlocal
996 34218 : IF (PRESENT(nppnl)) nppnl = potential%nppnl
997 34218 : IF (PRESENT(lmax)) lmax = potential%lmax
998 34974 : IF (PRESENT(is_nonlocal)) is_nonlocal(:) = potential%is_nonlocal(:)
999 34218 : IF (PRESENT(a_nonlocal)) a_nonlocal => potential%a_nonlocal
1000 34218 : IF (PRESENT(c_nonlocal)) c_nonlocal => potential%c_nonlocal
1001 34218 : IF (PRESENT(h_nonlocal)) h_nonlocal => potential%h_nonlocal
1002 34218 : IF (PRESENT(cprj_ppnl)) cprj_ppnl => potential%cprj_ppnl
1003 34218 : IF (PRESENT(vprj_ppnl)) vprj_ppnl => potential%vprj_ppnl
1004 :
1005 34218 : IF (PRESENT(has_nlcc)) has_nlcc = potential%has_nlcc
1006 34218 : IF (PRESENT(n_nlcc)) n_nlcc = potential%n_nlcc
1007 34218 : IF (PRESENT(a_nlcc)) a_nlcc => potential%a_nlcc
1008 34218 : IF (PRESENT(c_nlcc)) c_nlcc => potential%c_nlcc
1009 :
1010 34218 : END SUBROUTINE get_sgp_potential
1011 :
1012 : ! **************************************************************************************************
1013 : !> \brief Initialise the coefficients of the projectors of the non-local
1014 : !> part of the GTH pseudopotential and the transformation matrices
1015 : !> for Cartesian overlap integrals between the orbital basis
1016 : !> functions and the projector functions.
1017 : !> \param potential ...
1018 : !> \date 16.10.2000
1019 : !> \author MK
1020 : !> \version 1.0
1021 : ! **************************************************************************************************
1022 5013 : ELEMENTAL SUBROUTINE init_cprj_ppnl(potential)
1023 :
1024 : TYPE(gth_potential_type), INTENT(INOUT) :: potential
1025 :
1026 : INTEGER :: cpx, cpy, cpz, cx, cy, cz, ico, iprj, &
1027 : iprj_ppnl, l, lp, lprj_ppnl, nprj, px, &
1028 : py, pz
1029 : REAL(KIND=dp) :: alpha_ppnl, cp
1030 :
1031 5013 : nprj = 0
1032 :
1033 14615 : DO l = 0, potential%lppnl
1034 9602 : alpha_ppnl = potential%alpha_ppnl(l)
1035 21516 : DO iprj_ppnl = 1, potential%nprj_ppnl(l)
1036 6901 : lp = iprj_ppnl - 1
1037 6901 : lprj_ppnl = l + 2*lp
1038 : cp = SQRT(2.0_dp**(2.0_dp*REAL(lprj_ppnl, dp) + 3.5_dp)* &
1039 : alpha_ppnl**(REAL(lprj_ppnl, dp) + 1.5_dp)/ &
1040 6901 : (rootpi*dfac(2*lprj_ppnl + 1)))
1041 6901 : potential%cprj_ppnl(iprj_ppnl, l) = cp
1042 15086 : DO cx = 0, l
1043 24751 : DO cy = 0, l - cx
1044 9665 : cz = l - cx - cy
1045 9665 : iprj = nprj + co(cx, cy, cz)
1046 29239 : DO px = 0, lp
1047 34295 : DO py = 0, lp - px
1048 13241 : pz = lp - px - py
1049 13241 : cpx = cx + 2*px
1050 13241 : cpy = cy + 2*py
1051 13241 : cpz = cz + 2*pz
1052 13241 : ico = coset(cpx, cpy, cpz)
1053 24630 : potential%cprj(ico, iprj) = cp*fac(lp)/(fac(px)*fac(py)*fac(pz))
1054 : END DO
1055 : END DO
1056 : END DO
1057 : END DO
1058 16503 : nprj = nprj + nco(l)
1059 : END DO
1060 : END DO
1061 :
1062 5013 : END SUBROUTINE init_cprj_ppnl
1063 :
1064 : ! **************************************************************************************************
1065 : !> \brief Initialise a GTH potential data set structure.
1066 : !> \param potential ...
1067 : !> \date 27.10.2000
1068 : !> \author MK
1069 : !> \version 1.0
1070 : ! **************************************************************************************************
1071 9909 : SUBROUTINE init_gth_potential(potential)
1072 :
1073 : TYPE(gth_potential_type), INTENT(IN), POINTER :: potential
1074 :
1075 9909 : IF (.NOT. ASSOCIATED(potential)) RETURN
1076 :
1077 9909 : IF (potential%nppnl > 0) THEN
1078 :
1079 : ! Initialise the projector coefficients of the non-local part of the GTH pseudopotential
1080 : ! and the transformation matrices "pgf" -> "prj_ppnl"
1081 5013 : CALL init_cprj_ppnl(potential)
1082 :
1083 : ! Initialise the h(i,j) projector coefficients of the non-local part of the
1084 : ! GTH pseudopotential
1085 5013 : CALL init_vprj_ppnl(potential)
1086 :
1087 : END IF
1088 :
1089 : END SUBROUTINE init_gth_potential
1090 :
1091 : ! **************************************************************************************************
1092 : !> \brief Initialise the h(i,j) projector coefficients of the non-local part
1093 : !> of the GTH pseudopotential (and k(i,j) for SOC, see Hartwigsen, Goedecker, Hutter, PRB 1998).
1094 : !> \param potential ...
1095 : !> \date 24.10.2000
1096 : !> \author MK
1097 : !> \version 1.0
1098 : ! **************************************************************************************************
1099 5013 : ELEMENTAL SUBROUTINE init_vprj_ppnl(potential)
1100 :
1101 : TYPE(gth_potential_type), INTENT(INOUT) :: potential
1102 :
1103 : INTEGER :: i, ico, iprj, iprj_ppnl, iso, j, jco, &
1104 : jprj, jprj_ppnl, l, nprj
1105 :
1106 5013 : nprj = 0
1107 :
1108 14615 : DO l = 0, potential%lppnl
1109 16503 : DO iprj_ppnl = 1, potential%nprj_ppnl(l)
1110 6901 : iprj = nprj + (iprj_ppnl - 1)*nco(l)
1111 25628 : DO jprj_ppnl = 1, potential%nprj_ppnl(l)
1112 9125 : jprj = nprj + (jprj_ppnl - 1)*nco(l)
1113 29139 : DO ico = 1, nco(l)
1114 13113 : i = iprj + ico
1115 52091 : DO jco = 1, nco(l)
1116 29853 : j = jprj + jco
1117 140439 : DO iso = 1, nso(l)
1118 : potential%vprj_ppnl(i, j) = potential%vprj_ppnl(i, j) + &
1119 : orbtramat(l)%slm(iso, ico)* &
1120 : potential%hprj_ppnl(iprj_ppnl, &
1121 : jprj_ppnl, l)* &
1122 97473 : orbtramat(l)%slm(iso, jco)
1123 127326 : IF (potential%soc) THEN
1124 : ! Transform spin-orbit part
1125 : potential%wprj_ppnl(i, j) = potential%wprj_ppnl(i, j) + &
1126 : orbtramat(l)%slm(iso, ico)* &
1127 : potential%kprj_ppnl(iprj_ppnl, &
1128 : jprj_ppnl, l)* &
1129 10850 : orbtramat(l)%slm(iso, jco)
1130 : END IF
1131 : END DO
1132 : END DO
1133 : END DO
1134 : END DO
1135 : END DO
1136 14615 : nprj = nprj + potential%nprj_ppnl(l)*nco(l)
1137 : END DO
1138 :
1139 5013 : END SUBROUTINE init_vprj_ppnl
1140 :
1141 : ! **************************************************************************************************
1142 : !> \brief ...
1143 : !> \param potential ...
1144 : !> \param itype ...
1145 : !> \param zeff ...
1146 : !> \param zeff_correction ...
1147 : ! **************************************************************************************************
1148 4848 : PURE SUBROUTINE init_all_potential(potential, itype, zeff, zeff_correction)
1149 :
1150 : TYPE(all_potential_type), INTENT(INOUT), POINTER :: potential
1151 : CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: itype
1152 : REAL(KIND=dp), INTENT(IN), OPTIONAL :: zeff, zeff_correction
1153 :
1154 : INTEGER :: dz
1155 :
1156 4848 : IF (.NOT. ASSOCIATED(potential)) RETURN
1157 :
1158 4848 : IF (PRESENT(zeff)) potential%zeff = zeff
1159 4848 : IF (PRESENT(zeff_correction)) potential%zeff_correction = zeff_correction
1160 4848 : dz = potential%z - INT(potential%zeff - potential%zeff_correction)
1161 2000 : SELECT CASE (dz)
1162 : CASE DEFAULT
1163 : CASE (2)
1164 2000 : potential%elec_conf(0) = potential%elec_conf(0) - 2
1165 : CASE (10)
1166 630 : potential%elec_conf(0) = potential%elec_conf(0) - 4
1167 630 : potential%elec_conf(1) = potential%elec_conf(1) - 6
1168 : CASE (18)
1169 448 : potential%elec_conf(0) = potential%elec_conf(0) - 6
1170 448 : potential%elec_conf(1) = potential%elec_conf(1) - 12
1171 : CASE (28)
1172 170 : potential%elec_conf(0) = potential%elec_conf(0) - 6
1173 170 : potential%elec_conf(1) = potential%elec_conf(1) - 12
1174 170 : potential%elec_conf(2) = potential%elec_conf(2) - 10
1175 : CASE (30)
1176 0 : potential%elec_conf(0) = potential%elec_conf(0) - 8
1177 0 : potential%elec_conf(1) = potential%elec_conf(1) - 12
1178 0 : potential%elec_conf(2) = potential%elec_conf(2) - 10
1179 : CASE (36)
1180 170 : potential%elec_conf(0) = potential%elec_conf(0) - 8
1181 170 : potential%elec_conf(1) = potential%elec_conf(1) - 18
1182 170 : potential%elec_conf(2) = potential%elec_conf(2) - 10
1183 : CASE (46)
1184 152 : potential%elec_conf(0) = potential%elec_conf(0) - 8
1185 152 : potential%elec_conf(1) = potential%elec_conf(1) - 18
1186 152 : potential%elec_conf(2) = potential%elec_conf(2) - 20
1187 : CASE (48)
1188 0 : potential%elec_conf(0) = potential%elec_conf(0) - 10
1189 0 : potential%elec_conf(1) = potential%elec_conf(1) - 18
1190 0 : potential%elec_conf(2) = potential%elec_conf(2) - 20
1191 : CASE (54)
1192 34 : potential%elec_conf(0) = potential%elec_conf(0) - 10
1193 34 : potential%elec_conf(1) = potential%elec_conf(1) - 24
1194 34 : potential%elec_conf(2) = potential%elec_conf(2) - 20
1195 : CASE (68)
1196 122 : potential%elec_conf(0) = potential%elec_conf(0) - 10
1197 122 : potential%elec_conf(1) = potential%elec_conf(1) - 24
1198 122 : potential%elec_conf(2) = potential%elec_conf(2) - 20
1199 122 : potential%elec_conf(3) = potential%elec_conf(3) - 14
1200 : CASE (78)
1201 72 : potential%elec_conf(0) = potential%elec_conf(0) - 10
1202 72 : potential%elec_conf(1) = potential%elec_conf(1) - 24
1203 72 : potential%elec_conf(2) = potential%elec_conf(2) - 30
1204 72 : potential%elec_conf(3) = potential%elec_conf(3) - 14
1205 : CASE (80)
1206 0 : potential%elec_conf(0) = potential%elec_conf(0) - 12
1207 0 : potential%elec_conf(1) = potential%elec_conf(1) - 24
1208 0 : potential%elec_conf(2) = potential%elec_conf(2) - 30
1209 0 : potential%elec_conf(3) = potential%elec_conf(3) - 14
1210 : CASE (86)
1211 0 : potential%elec_conf(0) = potential%elec_conf(0) - 12
1212 0 : potential%elec_conf(1) = potential%elec_conf(1) - 30
1213 0 : potential%elec_conf(2) = potential%elec_conf(2) - 30
1214 0 : potential%elec_conf(3) = potential%elec_conf(3) - 14
1215 : CASE (100)
1216 0 : potential%elec_conf(0) = potential%elec_conf(0) - 12
1217 0 : potential%elec_conf(1) = potential%elec_conf(1) - 30
1218 0 : potential%elec_conf(2) = potential%elec_conf(2) - 30
1219 4848 : potential%elec_conf(3) = potential%elec_conf(3) - 28
1220 : END SELECT
1221 :
1222 4848 : IF (PRESENT(itype)) THEN
1223 4848 : IF (itype == "BARE") THEN
1224 4848 : potential%description(1) = "Bare Coulomb Potential"
1225 4848 : IF (dz > 0) THEN
1226 3804 : potential%description(2) = "Valence charge only"
1227 : ELSE
1228 1044 : potential%description(2) = "Full atomic charge"
1229 : END IF
1230 : END IF
1231 : END IF
1232 :
1233 : END SUBROUTINE init_all_potential
1234 : ! **************************************************************************************************
1235 : !> \brief Initialise a SGP potential data set structure.
1236 : !> \param potential ...
1237 : !> \version 1.0
1238 : ! **************************************************************************************************
1239 108 : SUBROUTINE init_sgp_potential(potential)
1240 : TYPE(sgp_potential_type), INTENT(IN), POINTER :: potential
1241 :
1242 : INTEGER :: i1, i2, j1, j2, l, la, lb, n1, n2, nnl, &
1243 : nprj
1244 108 : INTEGER, ALLOCATABLE, DIMENSION(:, :) :: ind1, ind2
1245 108 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: cprj, hnl
1246 108 : REAL(KIND=dp), DIMENSION(:, :, :), POINTER :: cn
1247 :
1248 108 : IF (ASSOCIATED(potential)) THEN
1249 108 : IF (ALLOCATED(potential%upf_data)) THEN
1250 24 : potential%nppnl = 0
1251 24 : IF (potential%upf_data%number_of_proj > 0) THEN
1252 12 : IF (potential%upf_projectors%degree < 0) THEN
1253 12 : CALL upf_projector_init(potential%upf_data, 0, potential%upf_projectors)
1254 : END IF
1255 12 : potential%nppnl = potential%upf_projectors%nproj
1256 : END IF
1257 : RETURN
1258 : END IF
1259 84 : IF (potential%nppnl > 0) THEN
1260 : !
1261 2 : IF (ASSOCIATED(potential%cprj_ppnl)) THEN
1262 0 : DEALLOCATE (potential%cprj_ppnl)
1263 : END IF
1264 2 : nnl = potential%n_nonlocal
1265 2 : nprj = 0
1266 14 : DO l = 0, potential%lmax
1267 14 : nprj = nprj + nnl*nso(l)
1268 : END DO
1269 8 : ALLOCATE (potential%cprj_ppnl(potential%nppnl, nprj))
1270 2 : cprj => potential%cprj_ppnl
1271 4106 : cprj = 0.0_dp
1272 2 : cn => potential%c_nonlocal
1273 : !
1274 6 : ALLOCATE (ind1(potential%nppnl, 3))
1275 4 : n1 = 0
1276 4 : DO i1 = 1, nnl
1277 16 : DO la = 0, potential%lmax
1278 126 : DO j1 = 1, nco(la)
1279 112 : n1 = n1 + 1
1280 112 : ind1(n1, 1) = la
1281 112 : ind1(n1, 2) = j1
1282 124 : ind1(n1, 3) = i1
1283 : END DO
1284 : END DO
1285 : END DO
1286 : !
1287 6 : ALLOCATE (ind2(nprj, 3))
1288 4 : n2 = 0
1289 4 : DO i2 = 1, nnl
1290 16 : DO lb = 0, potential%lmax
1291 86 : DO j2 = 1, nso(lb)
1292 72 : n2 = n2 + 1
1293 72 : ind2(n2, 1) = lb
1294 72 : ind2(n2, 2) = j2
1295 84 : ind2(n2, 3) = i2
1296 : END DO
1297 : END DO
1298 : END DO
1299 : !
1300 114 : DO n1 = 1, SIZE(ind1, 1)
1301 112 : la = ind1(n1, 1)
1302 112 : j1 = ind1(n1, 2)
1303 112 : i1 = ind1(n1, 3)
1304 4146 : DO n2 = 1, SIZE(ind2, 1)
1305 4032 : lb = ind2(n2, 1)
1306 4032 : IF (la /= lb) CYCLE
1307 952 : j2 = ind2(n2, 2)
1308 952 : i2 = ind2(n2, 3)
1309 : ! Primitive overlap integrals contain unnormalized Cartesian
1310 : ! monomials. SGP radial coefficients include 1/sqrt(4*pi),
1311 : ! whereas slm supplies unit-normalized real solid harmonics.
1312 4144 : cprj(n1, n2) = SQRT(fourpi)*orbtramat(la)%slm(j2, j1)*cn(i1, i2, la)
1313 : END DO
1314 : END DO
1315 : !
1316 2 : hnl => potential%h_nonlocal
1317 2 : IF (ASSOCIATED(potential%vprj_ppnl)) THEN
1318 0 : DEALLOCATE (potential%vprj_ppnl)
1319 : END IF
1320 6 : ALLOCATE (potential%vprj_ppnl(nprj))
1321 74 : potential%vprj_ppnl = 0.0_dp
1322 74 : DO n2 = 1, SIZE(ind2, 1)
1323 72 : lb = ind2(n2, 1)
1324 72 : i2 = ind2(n2, 3)
1325 74 : potential%vprj_ppnl(n2) = hnl(i2, lb)
1326 : END DO
1327 : !
1328 2 : DEALLOCATE (ind1, ind2)
1329 : END IF
1330 : END IF
1331 :
1332 108 : END SUBROUTINE init_sgp_potential
1333 :
1334 : ! **************************************************************************************************
1335 : !> \brief Read an atomic all-electron potential data set.
1336 : !> \param element_symbol ...
1337 : !> \param potential_name ...
1338 : !> \param potential ...
1339 : !> \param zeff_correction ...
1340 : !> \param para_env ...
1341 : !> \param potential_file_name ...
1342 : !> \param potential_section ...
1343 : !> \param update_input ...
1344 : !> \param potential_found ...
1345 : !> \date 14.05.2000
1346 : !> \author MK
1347 : !> \version 1.0
1348 : ! **************************************************************************************************
1349 2928 : SUBROUTINE read_all_potential(element_symbol, potential_name, potential, zeff_correction, &
1350 : para_env, potential_file_name, potential_section, update_input, &
1351 : potential_found)
1352 :
1353 : CHARACTER(LEN=*), INTENT(IN) :: element_symbol, potential_name
1354 : TYPE(all_potential_type), INTENT(INOUT) :: potential
1355 : REAL(KIND=dp), INTENT(IN) :: zeff_correction
1356 : TYPE(mp_para_env_type), INTENT(IN), POINTER :: para_env
1357 : CHARACTER(len=default_path_length), INTENT(IN) :: potential_file_name
1358 : TYPE(section_vals_type), INTENT(IN), POINTER :: potential_section
1359 : LOGICAL, INTENT(IN) :: update_input
1360 : LOGICAL, INTENT(OUT), OPTIONAL :: potential_found
1361 :
1362 : CHARACTER(LEN=240) :: line
1363 : CHARACTER(LEN=242) :: line2
1364 : CHARACTER(len=5*default_string_length) :: line_att
1365 1464 : CHARACTER(LEN=LEN(element_symbol)) :: symbol
1366 1464 : CHARACTER(LEN=LEN(element_symbol)+2) :: symbol2
1367 1464 : CHARACTER(LEN=LEN(potential_name)) :: apname
1368 1464 : CHARACTER(LEN=LEN(potential_name)+2) :: apname2
1369 : INTEGER :: irep, l, strlen1, strlen2
1370 1464 : INTEGER, DIMENSION(:), POINTER :: elec_conf
1371 : LOGICAL :: found, is_ok, match, read_from_input
1372 : REAL(KIND=dp) :: alpha, r
1373 : TYPE(cp_parser_type), POINTER :: parser
1374 : TYPE(cp_sll_val_type), POINTER :: list
1375 : TYPE(val_type), POINTER :: val
1376 :
1377 1464 : line2 = ""
1378 1464 : symbol2 = ""
1379 1464 : apname2 = ""
1380 1464 : NULLIFY (parser)
1381 1464 : CALL cite_reference(Krack2000)
1382 :
1383 1464 : IF (PRESENT(potential_found)) potential_found = .FALSE.
1384 :
1385 1464 : potential%name = potential_name
1386 : read_from_input = .FALSE.
1387 1464 : CALL section_vals_get(potential_section, explicit=read_from_input)
1388 1464 : IF (.NOT. read_from_input) THEN
1389 4344 : ALLOCATE (parser)
1390 1448 : CALL parser_create(parser, potential_file_name, para_env=para_env)
1391 : END IF
1392 :
1393 : ! Search for the requested potential in the potential file
1394 : ! until the potential is found or the end of file is reached
1395 :
1396 1464 : apname = potential_name
1397 1464 : symbol = element_symbol
1398 1464 : irep = 0
1399 : search_loop: DO
1400 6664 : IF (read_from_input) THEN
1401 16 : NULLIFY (list, val)
1402 16 : found = .TRUE.
1403 16 : CALL section_vals_list_get(potential_section, "_DEFAULT_KEYWORD_", list=list)
1404 : ELSE
1405 6648 : CALL parser_search_string(parser, TRIM(apname), .TRUE., found, line)
1406 : END IF
1407 6664 : IF (found) THEN
1408 6660 : CALL uppercase(symbol)
1409 6660 : CALL uppercase(apname)
1410 :
1411 6660 : IF (read_from_input) THEN
1412 : match = .TRUE.
1413 : ELSE
1414 : ! Check both the element symbol and the atomic potential name
1415 6644 : match = .FALSE.
1416 6644 : CALL uppercase(line)
1417 6644 : line2 = " "//line//" "
1418 6644 : symbol2 = " "//TRIM(symbol)//" "
1419 6644 : apname2 = " "//TRIM(apname)//" "
1420 6644 : strlen1 = LEN_TRIM(symbol2) + 1
1421 6644 : strlen2 = LEN_TRIM(apname2) + 1
1422 :
1423 6644 : IF ((INDEX(line2, symbol2(:strlen1)) > 0) .AND. &
1424 : (INDEX(line2, apname2(:strlen2)) > 0)) match = .TRUE.
1425 : END IF
1426 : IF (match) THEN
1427 : ! Read the electronic configuration
1428 1460 : NULLIFY (elec_conf)
1429 1460 : l = 0
1430 1460 : CALL reallocate(elec_conf, 0, l)
1431 1460 : IF (read_from_input) THEN
1432 16 : is_ok = cp_sll_val_next(list, val)
1433 16 : IF (.NOT. is_ok) THEN
1434 : CALL cp_abort(__LOCATION__, &
1435 0 : "Error reading the Potential from input file!")
1436 : END IF
1437 16 : CALL val_get(val, c_val=line_att)
1438 16 : READ (line_att, *) elec_conf(l)
1439 16 : CALL remove_word(line_att)
1440 50 : DO WHILE (LEN_TRIM(line_att) /= 0)
1441 34 : l = l + 1
1442 34 : CALL reallocate(elec_conf, 0, l)
1443 34 : READ (line_att, *) elec_conf(l)
1444 50 : CALL remove_word(line_att)
1445 : END DO
1446 : ELSE
1447 1444 : CALL parser_get_object(parser, elec_conf(l), newline=.TRUE.)
1448 4332 : DO WHILE (parser_test_next_token(parser) == "INT")
1449 2888 : l = l + 1
1450 2888 : CALL reallocate(elec_conf, 0, l)
1451 2888 : CALL parser_get_object(parser, elec_conf(l))
1452 : END DO
1453 1444 : irep = irep + 1
1454 1444 : IF (update_input) THEN
1455 5752 : WRITE (UNIT=line_att, FMT="(T8,*(1X,I0))") elec_conf(:)
1456 : CALL section_vals_val_set(potential_section, "_DEFAULT_KEYWORD_", i_rep_val=irep, &
1457 1438 : c_val=TRIM(line_att))
1458 : END IF
1459 : END IF
1460 :
1461 1460 : CALL reallocate(potential%elec_conf, 0, l)
1462 5842 : potential%elec_conf(:) = elec_conf(:)
1463 :
1464 1460 : potential%zeff_correction = zeff_correction
1465 5842 : potential%zeff = REAL(SUM(elec_conf), dp) + zeff_correction
1466 :
1467 1460 : DEALLOCATE (elec_conf)
1468 :
1469 : ! Read r(loc) to define the exponent of the core charge
1470 : ! distribution and calculate the corresponding coefficient
1471 :
1472 1460 : IF (read_from_input) THEN
1473 16 : is_ok = cp_sll_val_next(list, val)
1474 16 : IF (.NOT. is_ok) THEN
1475 : CALL cp_abort(__LOCATION__, &
1476 0 : "Error reading the Potential from input file!")
1477 : END IF
1478 16 : CALL val_get(val, c_val=line_att)
1479 16 : READ (line_att, *) r
1480 : ELSE
1481 1444 : CALL parser_get_object(parser, r, newline=.TRUE.)
1482 1444 : irep = irep + 1
1483 1444 : IF (update_input) THEN
1484 1438 : WRITE (UNIT=line_att, FMT="(T9,ES25.16E3)") r
1485 : CALL section_vals_val_set(potential_section, "_DEFAULT_KEYWORD_", i_rep_val=irep, &
1486 1438 : c_val=TRIM(line_att))
1487 : END IF
1488 : END IF
1489 1460 : alpha = 1.0_dp/(2.0_dp*r**2)
1490 :
1491 1460 : potential%alpha_core_charge = alpha
1492 1460 : potential%ccore_charge = potential%zeff*SQRT((alpha/pi)**3)
1493 :
1494 : EXIT search_loop
1495 : END IF
1496 : ELSE
1497 : ! Stop program, if the end of file is reached
1498 4 : IF (PRESENT(potential_found)) THEN
1499 4 : CALL parser_release(parser)
1500 4 : DEALLOCATE (parser)
1501 4 : RETURN
1502 : END IF
1503 : CALL cp_abort(__LOCATION__, &
1504 : "The requested atomic potential <"// &
1505 : TRIM(potential_name)// &
1506 : "> for element <"// &
1507 : TRIM(symbol)// &
1508 : "> was not found in the potential file <"// &
1509 0 : TRIM(potential_file_name)//">")
1510 : END IF
1511 : END DO search_loop
1512 :
1513 1460 : IF (PRESENT(potential_found)) potential_found = .TRUE.
1514 :
1515 1460 : IF (.NOT. read_from_input) THEN
1516 : ! Dump the potential info in the potential section
1517 1444 : IF (match .AND. update_input) THEN
1518 1438 : irep = irep + 1
1519 : WRITE (UNIT=line_att, FMT="(T9,A)") &
1520 : "# Potential name: "//TRIM(ADJUSTL(apname2(:strlen2)))// &
1521 1438 : " for element symbol: "//TRIM(ADJUSTL(symbol2(:strlen1)))
1522 : CALL section_vals_val_set(potential_section, "_DEFAULT_KEYWORD_", i_rep_val=irep, &
1523 1438 : c_val=TRIM(line_att))
1524 1438 : irep = irep + 1
1525 : WRITE (UNIT=line_att, FMT="(T9,A)") &
1526 1438 : "# Potential read from the potential filename: "//TRIM(ADJUSTL(potential_file_name))
1527 : CALL section_vals_val_set(potential_section, "_DEFAULT_KEYWORD_", i_rep_val=irep, &
1528 1438 : c_val=TRIM(line_att))
1529 : END IF
1530 1444 : CALL parser_release(parser)
1531 1444 : DEALLOCATE (parser)
1532 : END IF
1533 :
1534 1464 : END SUBROUTINE read_all_potential
1535 :
1536 : ! **************************************************************************************************
1537 : !> \brief Read an all-electron potential from an ordered list of library files.
1538 : !> \param element_symbol ...
1539 : !> \param potential_name ...
1540 : !> \param potential ...
1541 : !> \param zeff_correction ...
1542 : !> \param para_env ...
1543 : !> \param potential_file_names ...
1544 : !> \param potential_section ...
1545 : !> \param update_input ...
1546 : ! **************************************************************************************************
1547 1460 : SUBROUTINE read_all_potential_files(element_symbol, potential_name, potential, zeff_correction, &
1548 1460 : para_env, potential_file_names, potential_section, update_input)
1549 :
1550 : CHARACTER(LEN=*), INTENT(IN) :: element_symbol, potential_name
1551 : TYPE(all_potential_type), INTENT(INOUT) :: potential
1552 : REAL(KIND=dp), INTENT(IN) :: zeff_correction
1553 : TYPE(mp_para_env_type), INTENT(IN), POINTER :: para_env
1554 : CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: potential_file_names
1555 : TYPE(section_vals_type), INTENT(IN), POINTER :: potential_section
1556 : LOGICAL, INTENT(IN) :: update_input
1557 :
1558 : INTEGER :: i
1559 : LOGICAL :: potential_found
1560 :
1561 1464 : DO i = 1, SIZE(potential_file_names)
1562 : CALL read_all_potential(element_symbol, potential_name, potential, zeff_correction, &
1563 : para_env, potential_file_names(i), potential_section, update_input, &
1564 1464 : potential_found)
1565 1464 : IF (potential_found) RETURN
1566 : END DO
1567 0 : CALL potential_files_not_found(element_symbol, potential_name, potential_file_names)
1568 :
1569 : END SUBROUTINE read_all_potential_files
1570 :
1571 : ! **************************************************************************************************
1572 : !> \brief Read an atomic local potential data set.
1573 : !> \param element_symbol ...
1574 : !> \param potential_name ...
1575 : !> \param potential ...
1576 : !> \param para_env ...
1577 : !> \param potential_file_name ...
1578 : !> \param potential_section ...
1579 : !> \param update_input ...
1580 : !> \param potential_found ...
1581 : !> \date 24.12.2014
1582 : !> \author JGH
1583 : !> \version 1.0
1584 : ! **************************************************************************************************
1585 48 : SUBROUTINE read_local_potential(element_symbol, potential_name, potential, &
1586 : para_env, potential_file_name, potential_section, update_input, &
1587 : potential_found)
1588 :
1589 : CHARACTER(LEN=*), INTENT(IN) :: element_symbol, potential_name
1590 : TYPE(local_potential_type), INTENT(INOUT) :: potential
1591 : TYPE(mp_para_env_type), INTENT(IN), POINTER :: para_env
1592 : CHARACTER(len=default_path_length), INTENT(IN) :: potential_file_name
1593 : TYPE(section_vals_type), INTENT(IN), POINTER :: potential_section
1594 : LOGICAL, INTENT(IN) :: update_input
1595 : LOGICAL, INTENT(OUT), OPTIONAL :: potential_found
1596 :
1597 : REAL(KIND=dp), PARAMETER :: eps_tpot = 1.0E-10_dp
1598 :
1599 : CHARACTER(LEN=240) :: line
1600 : CHARACTER(LEN=242) :: line2
1601 : CHARACTER(len=5*default_string_length) :: line_att
1602 24 : CHARACTER(LEN=LEN(element_symbol)) :: symbol
1603 24 : CHARACTER(LEN=LEN(element_symbol)+2) :: symbol2
1604 24 : CHARACTER(LEN=LEN(potential_name)) :: apname
1605 24 : CHARACTER(LEN=LEN(potential_name)+2) :: apname2
1606 : INTEGER :: igau, ipol, irep, l, ngau, npol, &
1607 : strlen1, strlen2
1608 : LOGICAL :: found, is_ok, match, read_from_input
1609 24 : REAL(KIND=dp), DIMENSION(:), POINTER :: alpha
1610 24 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: cval
1611 : TYPE(cp_parser_type), POINTER :: parser
1612 : TYPE(cp_sll_val_type), POINTER :: list
1613 : TYPE(val_type), POINTER :: val
1614 :
1615 24 : line2 = ""
1616 24 : symbol2 = ""
1617 24 : apname2 = ""
1618 24 : NULLIFY (parser, alpha, cval)
1619 :
1620 24 : IF (PRESENT(potential_found)) potential_found = .FALSE.
1621 :
1622 24 : potential%name = potential_name
1623 : read_from_input = .FALSE.
1624 24 : CALL section_vals_get(potential_section, explicit=read_from_input)
1625 24 : IF (.NOT. read_from_input) THEN
1626 72 : ALLOCATE (parser)
1627 24 : CALL parser_create(parser, potential_file_name, para_env=para_env)
1628 : END IF
1629 :
1630 : ! Search for the requested potential in the potential file
1631 : ! until the potential is found or the end of file is reached
1632 :
1633 24 : apname = potential_name
1634 24 : symbol = element_symbol
1635 24 : irep = 0
1636 : search_loop: DO
1637 32 : IF (read_from_input) THEN
1638 0 : NULLIFY (list, val)
1639 0 : found = .TRUE.
1640 0 : CALL section_vals_list_get(potential_section, "_DEFAULT_KEYWORD_", list=list)
1641 : ELSE
1642 32 : CALL parser_search_string(parser, TRIM(apname), .TRUE., found, line)
1643 : END IF
1644 32 : IF (found) THEN
1645 32 : CALL uppercase(symbol)
1646 32 : CALL uppercase(apname)
1647 :
1648 32 : IF (read_from_input) THEN
1649 : match = .TRUE.
1650 : ELSE
1651 : ! Check both the element symbol and the atomic potential name
1652 32 : match = .FALSE.
1653 32 : CALL uppercase(line)
1654 32 : line2 = " "//line//" "
1655 32 : symbol2 = " "//TRIM(symbol)//" "
1656 32 : apname2 = " "//TRIM(apname)//" "
1657 32 : strlen1 = LEN_TRIM(symbol2) + 1
1658 32 : strlen2 = LEN_TRIM(apname2) + 1
1659 :
1660 32 : IF ((INDEX(line2, symbol2(:strlen1)) > 0) .AND. &
1661 : (INDEX(line2, apname2(:strlen2)) > 0)) match = .TRUE.
1662 : END IF
1663 : IF (match) THEN
1664 :
1665 : ! Read ngau and npol
1666 24 : IF (read_from_input) THEN
1667 0 : is_ok = cp_sll_val_next(list, val)
1668 0 : IF (.NOT. is_ok) THEN
1669 : CALL cp_abort(__LOCATION__, &
1670 0 : "Error reading the Potential from input file!")
1671 : END IF
1672 0 : CALL val_get(val, c_val=line_att)
1673 0 : READ (line_att, *) ngau, npol
1674 0 : CALL remove_word(line_att)
1675 : ELSE
1676 24 : CALL parser_get_object(parser, ngau, newline=.TRUE.)
1677 24 : CALL parser_get_object(parser, npol)
1678 24 : irep = irep + 1
1679 24 : IF (update_input) THEN
1680 24 : WRITE (UNIT=line_att, FMT="(2(1X,I0))") ngau, npol
1681 : CALL section_vals_val_set(potential_section, "_DEFAULT_KEYWORD_", i_rep_val=irep, &
1682 24 : c_val=TRIM(line_att))
1683 : END IF
1684 : END IF
1685 :
1686 24 : CALL reallocate(alpha, 1, ngau)
1687 24 : CALL reallocate(cval, 1, ngau, 1, npol)
1688 80 : DO igau = 1, ngau
1689 80 : IF (read_from_input) THEN
1690 0 : is_ok = cp_sll_val_next(list, val)
1691 0 : IF (.NOT. is_ok) THEN
1692 : CALL cp_abort(__LOCATION__, &
1693 0 : "Error reading the Potential from input file!")
1694 : END IF
1695 0 : CALL val_get(val, c_val=line_att)
1696 0 : READ (line_att, *) alpha(igau), (cval(igau, ipol), ipol=1, npol)
1697 : ELSE
1698 56 : CALL parser_get_object(parser, alpha(igau), newline=.TRUE.)
1699 136 : DO ipol = 1, npol
1700 136 : CALL parser_get_object(parser, cval(igau, ipol), newline=.FALSE.)
1701 : END DO
1702 56 : irep = irep + 1
1703 56 : IF (update_input) THEN
1704 136 : WRITE (UNIT=line_att, FMT="(*(ES25.16E3))") alpha(igau), (cval(igau, ipol), ipol=1, npol)
1705 : CALL section_vals_val_set(potential_section, "_DEFAULT_KEYWORD_", i_rep_val=irep, &
1706 56 : c_val=TRIM(line_att))
1707 : END IF
1708 : END IF
1709 : END DO
1710 80 : alpha = 1.0_dp/(2.0_dp*alpha**2)
1711 :
1712 24 : potential%ngau = ngau
1713 24 : potential%npol = npol
1714 :
1715 24 : potential%alpha => alpha
1716 24 : potential%cval => cval
1717 :
1718 24 : potential%radius = 0.0_dp
1719 80 : DO igau = 1, ngau
1720 160 : DO ipol = 1, npol
1721 80 : l = 2*(ipol - 1)
1722 : potential%radius = MAX(potential%radius, &
1723 : exp_radius(l, alpha(igau), eps_tpot, cval(igau, ipol), &
1724 136 : rlow=potential%radius))
1725 : END DO
1726 : END DO
1727 :
1728 : EXIT search_loop
1729 : END IF
1730 : ELSE
1731 : ! Stop program, if the end of file is reached
1732 0 : IF (PRESENT(potential_found)) THEN
1733 0 : CALL parser_release(parser)
1734 0 : DEALLOCATE (parser)
1735 0 : RETURN
1736 : END IF
1737 : CALL cp_abort(__LOCATION__, &
1738 : "The requested local atomic potential <"// &
1739 : TRIM(potential_name)// &
1740 : "> for element <"// &
1741 : TRIM(symbol)// &
1742 : "> was not found in the potential file <"// &
1743 0 : TRIM(potential_file_name)//">")
1744 : END IF
1745 : END DO search_loop
1746 :
1747 24 : IF (PRESENT(potential_found)) potential_found = .TRUE.
1748 :
1749 24 : IF (.NOT. read_from_input) THEN
1750 : ! Dump the potential info in the potential section
1751 24 : IF (match .AND. update_input) THEN
1752 24 : irep = irep + 1
1753 : WRITE (UNIT=line_att, FMT="(A)") &
1754 : "# Potential name: "//TRIM(ADJUSTL(apname2(:strlen2)))// &
1755 24 : " for element symbol: "//TRIM(ADJUSTL(symbol2(:strlen1)))
1756 : CALL section_vals_val_set(potential_section, "_DEFAULT_KEYWORD_", i_rep_val=irep, &
1757 24 : c_val=TRIM(line_att))
1758 24 : irep = irep + 1
1759 : WRITE (UNIT=line_att, FMT="(A)") &
1760 24 : "# Potential read from the potential filename: "//TRIM(ADJUSTL(potential_file_name))
1761 : CALL section_vals_val_set(potential_section, "_DEFAULT_KEYWORD_", i_rep_val=irep, &
1762 24 : c_val=TRIM(line_att))
1763 : END IF
1764 24 : CALL parser_release(parser)
1765 24 : DEALLOCATE (parser)
1766 : END IF
1767 :
1768 24 : END SUBROUTINE read_local_potential
1769 :
1770 : ! **************************************************************************************************
1771 : !> \brief Read a local potential from an ordered list of library files.
1772 : !> \param element_symbol ...
1773 : !> \param potential_name ...
1774 : !> \param potential ...
1775 : !> \param para_env ...
1776 : !> \param potential_file_names ...
1777 : !> \param potential_section ...
1778 : !> \param update_input ...
1779 : ! **************************************************************************************************
1780 24 : SUBROUTINE read_local_potential_files(element_symbol, potential_name, potential, &
1781 24 : para_env, potential_file_names, potential_section, update_input)
1782 :
1783 : CHARACTER(LEN=*), INTENT(IN) :: element_symbol, potential_name
1784 : TYPE(local_potential_type), INTENT(INOUT) :: potential
1785 : TYPE(mp_para_env_type), INTENT(IN), POINTER :: para_env
1786 : CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: potential_file_names
1787 : TYPE(section_vals_type), INTENT(IN), POINTER :: potential_section
1788 : LOGICAL, INTENT(IN) :: update_input
1789 :
1790 : INTEGER :: i
1791 : LOGICAL :: potential_found
1792 :
1793 24 : DO i = 1, SIZE(potential_file_names)
1794 : CALL read_local_potential(element_symbol, potential_name, potential, para_env, &
1795 24 : potential_file_names(i), potential_section, update_input, potential_found)
1796 24 : IF (potential_found) RETURN
1797 : END DO
1798 0 : CALL potential_files_not_found(element_symbol, potential_name, potential_file_names)
1799 :
1800 : END SUBROUTINE read_local_potential_files
1801 :
1802 : ! **************************************************************************************************
1803 : !> \brief Read an atomic GTH potential data set.
1804 : !> \param element_symbol ...
1805 : !> \param potential_name ...
1806 : !> \param potential ...
1807 : !> \param zeff_correction ...
1808 : !> \param para_env ...
1809 : !> \param potential_file_name ...
1810 : !> \param potential_section ...
1811 : !> \param update_input ...
1812 : !> \param monovalent ...
1813 : !> \param potential_found ...
1814 : !> \date 14.05.2000
1815 : !> \par Literature
1816 : !> - S. Goedecker, M. Teter and J. Hutter,
1817 : !> Phys. Rev. B 54, 1703 (1996)
1818 : !> - C. Hartwigsen, S. Goedecker and J. Hutter,
1819 : !> Phys. Rev. B 58, 3641 (1998)
1820 : !> \par History
1821 : !> - Add SOC key (27.06.2023, MK)
1822 : !> \author MK
1823 : !> \version 1.0
1824 : ! **************************************************************************************************
1825 19946 : SUBROUTINE read_gth_potential(element_symbol, potential_name, potential, zeff_correction, &
1826 : para_env, potential_file_name, potential_section, update_input, &
1827 : monovalent, potential_found)
1828 :
1829 : CHARACTER(LEN=*), INTENT(IN) :: element_symbol, potential_name
1830 : TYPE(gth_potential_type), INTENT(INOUT) :: potential
1831 : REAL(KIND=dp), INTENT(IN) :: zeff_correction
1832 : TYPE(mp_para_env_type), INTENT(IN), POINTER :: para_env
1833 : CHARACTER(len=default_path_length), INTENT(IN) :: potential_file_name
1834 : TYPE(section_vals_type), INTENT(IN), POINTER :: potential_section
1835 : LOGICAL, INTENT(IN) :: update_input
1836 : LOGICAL, INTENT(IN), OPTIONAL :: monovalent
1837 : LOGICAL, INTENT(OUT), OPTIONAL :: potential_found
1838 :
1839 : CHARACTER(LEN=240) :: line
1840 : CHARACTER(LEN=242) :: line2
1841 : CHARACTER(len=5*default_string_length) :: line_att
1842 9973 : CHARACTER(LEN=LEN(element_symbol)) :: symbol
1843 9973 : CHARACTER(LEN=LEN(element_symbol)+2) :: symbol2
1844 9973 : CHARACTER(LEN=LEN(potential_name)) :: apname
1845 9973 : CHARACTER(LEN=LEN(potential_name)+2) :: apname2
1846 : INTEGER :: i, ic, ipot, irep, istr, j, l, lppnl, &
1847 : lprj_ppnl_max, maxlppl, n, nppnl, &
1848 : nprj_ppnl, nprj_ppnl_max, strlen1, &
1849 : strlen2
1850 9973 : INTEGER, DIMENSION(:), POINTER :: elec_conf
1851 : LOGICAL :: found, is_ok, match, read_from_input
1852 : REAL(KIND=dp) :: alpha, ci, r, rc2
1853 9973 : REAL(KIND=dp), DIMENSION(:), POINTER :: tmp_vals
1854 9973 : REAL(KIND=dp), DIMENSION(:, :, :), POINTER :: hprj_ppnl, kprj_ppnl
1855 : TYPE(cp_parser_type), POINTER :: parser
1856 : TYPE(cp_sll_val_type), POINTER :: list
1857 : TYPE(val_type), POINTER :: val
1858 :
1859 9973 : line2 = ""
1860 9973 : symbol2 = ""
1861 9973 : apname2 = ""
1862 9973 : NULLIFY (parser, tmp_vals)
1863 9973 : CALL cite_reference(Goedecker1996)
1864 9973 : CALL cite_reference(Hartwigsen1998)
1865 9973 : CALL cite_reference(Krack2005)
1866 :
1867 9973 : IF (PRESENT(potential_found)) potential_found = .FALSE.
1868 :
1869 9973 : potential%monovalent = .FALSE.
1870 9973 : IF (PRESENT(monovalent)) potential%monovalent = monovalent
1871 :
1872 9973 : potential%name = potential_name
1873 9973 : potential%aliases = potential_name
1874 : read_from_input = .FALSE.
1875 9973 : CALL section_vals_get(potential_section, explicit=read_from_input)
1876 9973 : IF (.NOT. read_from_input) THEN
1877 27699 : ALLOCATE (parser)
1878 9233 : CALL parser_create(parser, potential_file_name, para_env=para_env)
1879 : END IF
1880 :
1881 : ! Initialize extended form
1882 9973 : potential%lpotextended = .FALSE.
1883 9973 : potential%nexp_lpot = 0
1884 9973 : potential%lsdpot = .FALSE.
1885 9973 : potential%nexp_lsd = 0
1886 9973 : potential%nlcc = .FALSE.
1887 9973 : potential%nexp_nlcc = 0
1888 :
1889 : ! Search for the requested potential in the potential file
1890 : ! until the potential is found or the end of file is reached
1891 9973 : apname = potential_name
1892 9973 : symbol = element_symbol
1893 9973 : irep = 0
1894 : search_loop: DO
1895 13259 : IF (read_from_input) THEN
1896 740 : NULLIFY (list, val)
1897 740 : found = .TRUE.
1898 740 : CALL section_vals_list_get(potential_section, "_DEFAULT_KEYWORD_", list=list)
1899 : ELSE
1900 12519 : CALL parser_search_string(parser, TRIM(apname), .TRUE., found, line)
1901 : END IF
1902 13259 : IF (found) THEN
1903 13257 : CALL uppercase(symbol)
1904 13257 : CALL uppercase(apname)
1905 13257 : IF (read_from_input) THEN
1906 : match = .TRUE.
1907 : ELSE
1908 : ! Check both the element symbol and the atomic potential name
1909 12517 : match = .FALSE.
1910 12517 : CALL uppercase(line)
1911 12517 : line2 = " "//line//" "
1912 12517 : symbol2 = " "//TRIM(symbol)//" "
1913 12517 : apname2 = " "//TRIM(apname)//" "
1914 12517 : strlen1 = LEN_TRIM(symbol2) + 1
1915 12517 : strlen2 = LEN_TRIM(apname2) + 1
1916 12517 : i = INDEX(line2, symbol2(:strlen1))
1917 12517 : j = INDEX(line2, apname2(:strlen2))
1918 12517 : IF (i > 0 .AND. j > 0) THEN
1919 9231 : match = .TRUE.
1920 9231 : i = i + 1 + INDEX(line2(i + 1:), " ")
1921 9231 : potential%aliases = line2(i:) ! copy all names into aliases field
1922 : END IF
1923 : END IF
1924 : IF (match) THEN
1925 : ! Read the electronic configuration
1926 9971 : NULLIFY (elec_conf)
1927 9971 : l = 0
1928 9971 : CALL reallocate(elec_conf, 0, l)
1929 9971 : IF (read_from_input) THEN
1930 740 : is_ok = cp_sll_val_next(list, val)
1931 740 : IF (.NOT. is_ok) THEN
1932 : CALL cp_abort(__LOCATION__, &
1933 0 : "Error while reading GTH potential from input file")
1934 : END IF
1935 740 : CALL val_get(val, c_val=line_att)
1936 740 : READ (line_att, *) elec_conf(l)
1937 740 : CALL remove_word(line_att)
1938 1126 : DO WHILE (LEN_TRIM(line_att) /= 0)
1939 386 : l = l + 1
1940 386 : CALL reallocate(elec_conf, 0, l)
1941 386 : READ (line_att, *) elec_conf(l)
1942 1126 : CALL remove_word(line_att)
1943 : END DO
1944 : ELSE
1945 9231 : CALL parser_get_object(parser, elec_conf(l), newline=.TRUE.)
1946 17050 : DO WHILE (parser_test_next_token(parser) == "INT")
1947 7819 : l = l + 1
1948 7819 : CALL reallocate(elec_conf, 0, l)
1949 7819 : CALL parser_get_object(parser, elec_conf(l))
1950 : END DO
1951 9231 : irep = irep + 1
1952 9231 : IF (update_input) THEN
1953 26145 : WRITE (UNIT=line_att, FMT="(T8,*(1X,I0))") elec_conf(:)
1954 : CALL section_vals_val_set(potential_section, "_DEFAULT_KEYWORD_", i_rep_val=irep, &
1955 9177 : c_val=TRIM(line_att))
1956 : END IF
1957 : END IF
1958 :
1959 9971 : CALL reallocate(potential%elec_conf, 0, l)
1960 9971 : IF (potential%monovalent) THEN
1961 2 : potential%elec_conf(0) = 1
1962 : ELSE
1963 28141 : potential%elec_conf(:) = elec_conf(:)
1964 : END IF
1965 :
1966 9971 : potential%zeff_correction = zeff_correction
1967 28147 : potential%zeff = REAL(SUM(potential%elec_conf), dp) + zeff_correction
1968 :
1969 9971 : DEALLOCATE (elec_conf)
1970 :
1971 : ! Read r(loc) to define the exponent of the core charge
1972 : ! distribution and calculate the corresponding coefficient
1973 9971 : IF (read_from_input) THEN
1974 740 : is_ok = cp_sll_val_next(list, val)
1975 740 : IF (.NOT. is_ok) THEN
1976 : CALL cp_abort(__LOCATION__, &
1977 0 : "Error while reading GTH potential from input file")
1978 : END IF
1979 740 : CALL val_get(val, c_val=line_att)
1980 740 : READ (line_att, *) r
1981 740 : CALL remove_word(line_att)
1982 : ELSE
1983 9231 : line_att = ""
1984 9231 : CALL parser_get_object(parser, r, newline=.TRUE.)
1985 9231 : istr = LEN_TRIM(line_att) + 1
1986 9231 : WRITE (UNIT=line_att(istr:), FMT="(T9,ES25.16E3)") r
1987 : END IF
1988 9971 : alpha = 1.0_dp/(2.0_dp*r**2)
1989 :
1990 9971 : potential%alpha_core_charge = alpha
1991 9971 : potential%ccore_charge = potential%zeff*SQRT((alpha/pi)**3)
1992 :
1993 9971 : potential%alpha_ppl = alpha
1994 9971 : potential%cerf_ppl = potential%zeff*SQRT((alpha/pi)**3)
1995 :
1996 : ! Read the parameters for the local part of the GTH pseudopotential (ppl)
1997 9971 : IF (read_from_input) THEN
1998 740 : READ (line_att, *) n
1999 740 : CALL remove_word(line_att)
2000 : ELSE
2001 9231 : CALL parser_get_object(parser, n)
2002 9231 : istr = LEN_TRIM(line_att) + 1
2003 9231 : WRITE (UNIT=line_att(istr:), FMT="(1X,I0)") n
2004 : END IF
2005 9971 : potential%nexp_ppl = n
2006 9971 : CALL reallocate(potential%cexp_ppl, 1, n)
2007 :
2008 29447 : DO i = 1, n
2009 19476 : IF (read_from_input) THEN
2010 1450 : READ (line_att, *) ci
2011 1450 : CALL remove_word(line_att)
2012 : ELSE
2013 18026 : CALL parser_get_object(parser, ci)
2014 18026 : istr = LEN_TRIM(line_att) + 1
2015 18026 : WRITE (UNIT=line_att(istr:), FMT="(ES25.16E3)") ci
2016 : END IF
2017 19476 : rc2 = (2.0_dp*potential%alpha_ppl)
2018 29447 : potential%cexp_ppl(i) = rc2**(i - 1)*ci
2019 : END DO
2020 :
2021 9971 : IF (.NOT. read_from_input) THEN
2022 9231 : irep = irep + 1
2023 9231 : IF (update_input) THEN
2024 : CALL section_vals_val_set(potential_section, "_DEFAULT_KEYWORD_", i_rep_val=irep, &
2025 9177 : c_val=TRIM(line_att))
2026 : END IF
2027 9231 : line_att = ""
2028 : ELSE
2029 740 : IF (LEN_TRIM(line_att) /= 0) THEN
2030 : CALL cp_abort(__LOCATION__, &
2031 0 : "Error while reading GTH potential from input file")
2032 : END IF
2033 : END IF
2034 9971 : maxlppl = 2*(n - 1)
2035 :
2036 9971 : IF (maxlppl > -1) CALL init_orbital_pointers(maxlppl)
2037 :
2038 : ! Read extended form of GTH pseudopotential
2039 : ! local potential, NLCC, LSD potential, spin-orbit coupling (SOC)
2040 9971 : IF (read_from_input) THEN
2041 : read_keywords_from_input: DO
2042 746 : is_ok = cp_sll_val_next(list, val)
2043 746 : CPASSERT(is_ok)
2044 746 : CALL val_get(val, c_val=line_att)
2045 1486 : IF (INDEX(line_att, "LPOT") /= 0) THEN
2046 0 : potential%lpotextended = .TRUE.
2047 0 : CALL remove_word(line_att)
2048 0 : READ (line_att, *) potential%nexp_lpot
2049 0 : n = potential%nexp_lpot
2050 0 : maxlppl = 2*(n - 1)
2051 0 : IF (maxlppl > -1) CALL init_orbital_pointers(maxlppl)
2052 0 : NULLIFY (potential%alpha_lpot, potential%nct_lpot, potential%cval_lpot)
2053 0 : CALL reallocate(potential%alpha_lpot, 1, n)
2054 0 : CALL reallocate(potential%nct_lpot, 1, n)
2055 0 : CALL reallocate(potential%cval_lpot, 1, 4, 1, n)
2056 0 : DO ipot = 1, potential%nexp_lpot
2057 0 : is_ok = cp_sll_val_next(list, val)
2058 0 : CPASSERT(is_ok)
2059 0 : CALL val_get(val, c_val=line_att)
2060 0 : READ (line_att, *) r
2061 0 : potential%alpha_lpot(ipot) = 0.5_dp/(r*r)
2062 0 : CALL remove_word(line_att)
2063 0 : READ (line_att, *) potential%nct_lpot(ipot)
2064 0 : CALL remove_word(line_att)
2065 0 : DO ic = 1, potential%nct_lpot(ipot)
2066 0 : READ (line_att, *) ci
2067 0 : rc2 = (2._dp*potential%alpha_lpot(ipot))**(ic - 1)
2068 0 : potential%cval_lpot(ic, ipot) = ci*rc2
2069 0 : CALL remove_word(line_att)
2070 : END DO
2071 : END DO
2072 746 : ELSE IF (INDEX(line_att, "NLCC") /= 0) THEN
2073 6 : potential%nlcc = .TRUE.
2074 6 : CALL remove_word(line_att)
2075 6 : READ (line_att, *) potential%nexp_nlcc
2076 6 : n = potential%nexp_nlcc
2077 6 : NULLIFY (potential%alpha_nlcc, potential%nct_nlcc, potential%cval_nlcc)
2078 6 : CALL reallocate(potential%alpha_nlcc, 1, n)
2079 6 : CALL reallocate(potential%nct_nlcc, 1, n)
2080 6 : CALL reallocate(potential%cval_nlcc, 1, 4, 1, n)
2081 12 : DO ipot = 1, potential%nexp_nlcc
2082 6 : is_ok = cp_sll_val_next(list, val)
2083 6 : CPASSERT(is_ok)
2084 6 : CALL val_get(val, c_val=line_att)
2085 6 : READ (line_att, *) potential%alpha_nlcc(ipot)
2086 6 : CALL remove_word(line_att)
2087 6 : READ (line_att, *) potential%nct_nlcc(ipot)
2088 6 : CALL remove_word(line_att)
2089 22 : DO ic = 1, potential%nct_nlcc(ipot)
2090 10 : READ (line_att, *) potential%cval_nlcc(ic, ipot)
2091 : ! Make it compatible with BigDFT style
2092 10 : potential%cval_nlcc(ic, ipot) = potential%cval_nlcc(ic, ipot)/(4.0_dp*pi)
2093 16 : CALL remove_word(line_att)
2094 : END DO
2095 : END DO
2096 740 : ELSE IF (INDEX(line_att, "LSD") /= 0) THEN
2097 0 : potential%lsdpot = .TRUE.
2098 0 : CALL remove_word(line_att)
2099 0 : READ (line_att, *) potential%nexp_lsd
2100 0 : n = potential%nexp_lsd
2101 0 : NULLIFY (potential%alpha_lsd, potential%nct_lsd, potential%cval_lsd)
2102 0 : CALL reallocate(potential%alpha_lsd, 1, n)
2103 0 : CALL reallocate(potential%nct_lsd, 1, n)
2104 0 : CALL reallocate(potential%cval_lsd, 1, 4, 1, n)
2105 0 : DO ipot = 1, potential%nexp_lsd
2106 0 : is_ok = cp_sll_val_next(list, val)
2107 0 : CPASSERT(is_ok)
2108 0 : CALL val_get(val, c_val=line_att)
2109 0 : READ (line_att, *) r
2110 0 : potential%alpha_lsd(ipot) = 0.5_dp/(r*r)
2111 0 : CALL remove_word(line_att)
2112 0 : READ (line_att, *) potential%nct_lsd(ipot)
2113 0 : CALL remove_word(line_att)
2114 0 : DO ic = 1, potential%nct_lsd(ipot)
2115 0 : READ (line_att, *) ci
2116 0 : rc2 = (2._dp*potential%alpha_lsd(ipot))**(ic - 1)
2117 0 : potential%cval_lsd(ic, ipot) = ci*rc2
2118 0 : CALL remove_word(line_att)
2119 : END DO
2120 : END DO
2121 : ELSE
2122 : EXIT read_keywords_from_input
2123 : END IF
2124 : END DO read_keywords_from_input
2125 : ELSE
2126 : read_keywords: DO
2127 9297 : CALL parser_get_next_line(parser, 1)
2128 9297 : IF (parser_test_next_token(parser) == "INT") THEN
2129 : EXIT read_keywords
2130 9363 : ELSE IF (parser_test_next_token(parser) == "STR") THEN
2131 66 : CALL parser_get_object(parser, line)
2132 66 : IF (INDEX(line, "LPOT") /= 0) THEN
2133 : ! Local potential
2134 8 : potential%lpotextended = .TRUE.
2135 8 : CALL parser_get_object(parser, potential%nexp_lpot)
2136 8 : n = potential%nexp_lpot
2137 8 : NULLIFY (potential%alpha_lpot, potential%nct_lpot, potential%cval_lpot)
2138 8 : CALL reallocate(potential%alpha_lpot, 1, n)
2139 8 : CALL reallocate(potential%nct_lpot, 1, n)
2140 8 : CALL reallocate(potential%cval_lpot, 1, 4, 1, n)
2141 : ! Add to input section
2142 8 : irep = irep + 1
2143 8 : IF (update_input) THEN
2144 8 : WRITE (UNIT=line_att, FMT="(T9,A,1X,I0)") "LPOT", n
2145 : CALL section_vals_val_set(potential_section, "_DEFAULT_KEYWORD_", i_rep_val=irep, &
2146 8 : c_val=TRIM(line_att))
2147 : END IF
2148 20 : DO ipot = 1, potential%nexp_lpot
2149 12 : CALL parser_get_object(parser, r, newline=.TRUE.)
2150 12 : potential%alpha_lpot(ipot) = 0.5_dp/(r*r)
2151 12 : CALL parser_get_object(parser, potential%nct_lpot(ipot))
2152 12 : CALL reallocate(tmp_vals, 1, potential%nct_lpot(ipot))
2153 38 : DO ic = 1, potential%nct_lpot(ipot)
2154 26 : CALL parser_get_object(parser, ci)
2155 26 : tmp_vals(ic) = ci
2156 26 : rc2 = (2._dp*potential%alpha_lpot(ipot))**(ic - 1)
2157 38 : potential%cval_lpot(ic, ipot) = ci*rc2
2158 : END DO
2159 : ! Add to input section
2160 12 : irep = irep + 1
2161 20 : IF (update_input) THEN
2162 : WRITE (UNIT=line_att, FMT="(T9,ES25.16E3,1X,I0,*(ES25.16E3))") &
2163 38 : r, potential%nct_lpot(ipot), tmp_vals(1:potential%nct_lpot(ipot))
2164 : CALL section_vals_val_set(potential_section, "_DEFAULT_KEYWORD_", i_rep_val=irep, &
2165 12 : c_val=TRIM(line_att))
2166 : END IF
2167 : END DO
2168 58 : ELSE IF (INDEX(line, "NLCC") /= 0) THEN
2169 : ! NLCC
2170 58 : potential%nlcc = .TRUE.
2171 58 : CALL parser_get_object(parser, potential%nexp_nlcc)
2172 58 : n = potential%nexp_nlcc
2173 58 : NULLIFY (potential%alpha_nlcc, potential%nct_nlcc, potential%cval_nlcc)
2174 58 : CALL reallocate(potential%alpha_nlcc, 1, n)
2175 58 : CALL reallocate(potential%nct_nlcc, 1, n)
2176 58 : CALL reallocate(potential%cval_nlcc, 1, 4, 1, n)
2177 : ! Add to input section
2178 58 : WRITE (UNIT=line_att, FMT="(T9,A,1X,I0)") "NLCC", n
2179 58 : irep = irep + 1
2180 : CALL section_vals_val_set(potential_section, "_DEFAULT_KEYWORD_", i_rep_val=irep, &
2181 58 : c_val=TRIM(line_att))
2182 116 : DO ipot = 1, potential%nexp_nlcc
2183 58 : CALL parser_get_object(parser, potential%alpha_nlcc(ipot), newline=.TRUE.)
2184 58 : CALL parser_get_object(parser, potential%nct_nlcc(ipot))
2185 58 : CALL reallocate(tmp_vals, 1, potential%nct_nlcc(ipot))
2186 116 : DO ic = 1, potential%nct_nlcc(ipot)
2187 58 : CALL parser_get_object(parser, potential%cval_nlcc(ic, ipot))
2188 58 : tmp_vals(ic) = potential%cval_nlcc(ic, ipot)
2189 : ! Make it compatible with BigDFT style
2190 116 : potential%cval_nlcc(ic, ipot) = potential%cval_nlcc(ic, ipot)/(4.0_dp*pi)
2191 : END DO
2192 : ! Add to input section
2193 58 : irep = irep + 1
2194 116 : IF (update_input) THEN
2195 : WRITE (UNIT=line_att, FMT="(T9,ES25.16E3,1X,I0,*(ES25.16E3))") &
2196 58 : potential%alpha_nlcc(ipot), potential%nct_nlcc(ipot), &
2197 174 : tmp_vals(1:potential%nct_nlcc(ipot))
2198 : CALL section_vals_val_set(potential_section, "_DEFAULT_KEYWORD_", i_rep_val=irep, &
2199 58 : c_val=TRIM(line_att))
2200 : END IF
2201 : END DO
2202 0 : ELSE IF (INDEX(line, "LSD") /= 0) THEN
2203 : ! LSD potential
2204 0 : potential%lsdpot = .TRUE.
2205 0 : CALL parser_get_object(parser, potential%nexp_lsd)
2206 0 : n = potential%nexp_lsd
2207 0 : NULLIFY (potential%alpha_lsd, potential%nct_lsd, potential%cval_lsd)
2208 0 : CALL reallocate(potential%alpha_lsd, 1, n)
2209 0 : CALL reallocate(potential%nct_lsd, 1, n)
2210 0 : CALL reallocate(potential%cval_lsd, 1, 4, 1, n)
2211 : ! Add to input section
2212 0 : irep = irep + 1
2213 0 : IF (update_input) THEN
2214 0 : WRITE (UNIT=line_att, FMT="(T9,A,1X,I0)") "LSD", n
2215 : CALL section_vals_val_set(potential_section, "_DEFAULT_KEYWORD_", i_rep_val=irep, &
2216 0 : c_val=TRIM(line_att))
2217 : END IF
2218 0 : DO ipot = 1, potential%nexp_lsd
2219 0 : CALL parser_get_object(parser, r, newline=.TRUE.)
2220 0 : potential%alpha_lsd(ipot) = 0.5_dp/(r*r)
2221 0 : CALL parser_get_object(parser, potential%nct_lsd(ipot))
2222 0 : CALL reallocate(tmp_vals, 1, potential%nct_lsd(ipot))
2223 0 : DO ic = 1, potential%nct_lsd(ipot)
2224 0 : CALL parser_get_object(parser, ci)
2225 0 : tmp_vals(ic) = ci
2226 0 : rc2 = (2._dp*potential%alpha_lsd(ipot))**(ic - 1)
2227 0 : potential%cval_lsd(ic, ipot) = ci*rc2
2228 : END DO
2229 : ! Add to input section
2230 0 : irep = irep + 1
2231 0 : IF (update_input) THEN
2232 0 : WRITE (UNIT=line_att, FMT="(T9,ES25.16E3,1X,I0,*(ES25.16E3))") r, potential%nct_lsd(ipot), &
2233 0 : tmp_vals(1:potential%nct_lsd(ipot))
2234 : CALL section_vals_val_set(potential_section, "_DEFAULT_KEYWORD_", i_rep_val=irep, &
2235 0 : c_val=TRIM(line_att))
2236 : END IF
2237 : END DO
2238 : ELSE
2239 : CALL cp_abort(__LOCATION__, &
2240 : "Syntax error for <"// &
2241 : TRIM(element_symbol)// &
2242 : "> in the atomic potential <"// &
2243 : TRIM(potential_name)// &
2244 : "> potential file <"// &
2245 : TRIM(potential_file_name)//">: "// &
2246 : "Expected LPOT/NLCC/LSD keyword, got: <"// &
2247 0 : TRIM(line)//">")
2248 : END IF
2249 : ELSE
2250 0 : CALL parser_get_object(parser, line)
2251 : CALL cp_abort(__LOCATION__, &
2252 : "Syntax error for <"// &
2253 : TRIM(element_symbol)// &
2254 : "> in the atomic potential <"// &
2255 : TRIM(potential_name)// &
2256 : "> potential file <"// &
2257 : TRIM(potential_file_name)//">: "// &
2258 : "Expected LPOT/NLCC/LSD keyword or INTEGER, got: <"// &
2259 66 : TRIM(line)//">")
2260 : END IF
2261 : END DO read_keywords
2262 : END IF
2263 :
2264 : ! Read the parameters for the non-local part of the GTH pseudopotential (ppnl)
2265 9971 : IF (read_from_input) THEN
2266 740 : READ (line_att, *) n
2267 740 : CALL remove_word(line_att)
2268 740 : IF (INDEX(line_att, "SOC") /= 0) THEN
2269 2 : potential%soc = .TRUE.
2270 2 : CALL remove_word(line_att)
2271 : END IF
2272 : ELSE
2273 9231 : CALL parser_get_object(parser, n)
2274 9231 : IF (parser_test_next_token(parser) == "STR") THEN
2275 104 : CALL parser_get_object(parser, line)
2276 9335 : IF (INDEX(line, "SOC") /= 0) potential%soc = .TRUE.
2277 : END IF
2278 9231 : irep = irep + 1
2279 9231 : IF (update_input) THEN
2280 9177 : IF (potential%soc) THEN
2281 104 : WRITE (UNIT=line_att, FMT="(T9,I0,2X,A)") n, "SOC"
2282 : ELSE
2283 9073 : WRITE (UNIT=line_att, FMT="(T9,I0)") n
2284 : END IF
2285 : CALL section_vals_val_set(potential_section, "_DEFAULT_KEYWORD_", i_rep_val=irep, &
2286 9177 : c_val=TRIM(line_att))
2287 : END IF
2288 : END IF
2289 9971 : potential%lppnl = n - 1
2290 9971 : potential%nppnl = 0
2291 :
2292 9971 : potential%lprj_ppnl_max = n - 1
2293 9971 : potential%nprj_ppnl_max = 0
2294 :
2295 9971 : IF (n > 0) THEN
2296 :
2297 5019 : lppnl = potential%lppnl
2298 5019 : nppnl = potential%nppnl
2299 :
2300 5019 : CALL init_orbital_pointers(lppnl)
2301 :
2302 5019 : NULLIFY (hprj_ppnl, kprj_ppnl)
2303 :
2304 : ! Load the parameter for n non-local projectors
2305 :
2306 5019 : CALL reallocate(potential%alpha_ppnl, 0, lppnl)
2307 5019 : CALL reallocate(potential%nprj_ppnl, 0, lppnl)
2308 :
2309 5019 : lprj_ppnl_max = -1
2310 5019 : nprj_ppnl_max = 0
2311 :
2312 14637 : DO l = 0, lppnl
2313 9618 : IF (read_from_input) THEN
2314 560 : is_ok = cp_sll_val_next(list, val)
2315 560 : IF (.NOT. is_ok) THEN
2316 : CALL cp_abort(__LOCATION__, &
2317 0 : "Error while reading GTH potential from input file")
2318 : END IF
2319 560 : CALL val_get(val, c_val=line_att)
2320 560 : READ (line_att, *) r
2321 560 : CALL remove_word(line_att)
2322 560 : READ (line_att, *) nprj_ppnl
2323 560 : CALL remove_word(line_att)
2324 : ELSE
2325 9058 : line_att = ""
2326 9058 : CALL parser_get_object(parser, r, newline=.TRUE.)
2327 9058 : CALL parser_get_object(parser, nprj_ppnl)
2328 9058 : istr = LEN_TRIM(line_att) + 1
2329 9058 : WRITE (UNIT=line_att(istr:), FMT="(T9,ES25.16E3,1X,I0)") r, nprj_ppnl
2330 : END IF
2331 9618 : IF (r == 0.0_dp .AND. nprj_ppnl /= 0) THEN
2332 : CALL cp_abort(__LOCATION__, &
2333 : "An error was detected in the atomic potential <"// &
2334 : TRIM(potential_name)// &
2335 : "> potential file <"// &
2336 0 : TRIM(potential_file_name)//">")
2337 : END IF
2338 9618 : potential%alpha_ppnl(l) = 0.0_dp
2339 9618 : IF (r /= 0.0_dp .AND. n /= 0) potential%alpha_ppnl(l) = 1.0_dp/(2.0_dp*r**2)
2340 9618 : potential%nprj_ppnl(l) = nprj_ppnl
2341 9618 : nppnl = nppnl + nprj_ppnl*nco(l)
2342 9618 : IF (nprj_ppnl > nprj_ppnl_max) THEN
2343 5019 : nprj_ppnl_max = nprj_ppnl
2344 : CALL reallocate(hprj_ppnl, 1, nprj_ppnl_max, &
2345 : 1, nprj_ppnl_max, &
2346 5019 : 0, lppnl)
2347 : CALL reallocate(kprj_ppnl, 1, nprj_ppnl_max, &
2348 : 1, nprj_ppnl_max, &
2349 5019 : 0, lppnl)
2350 : END IF
2351 16549 : DO i = 1, nprj_ppnl
2352 6931 : IF (i == 1) THEN
2353 5911 : IF (read_from_input) THEN
2354 326 : READ (line_att, *) hprj_ppnl(i, i, l)
2355 326 : CALL remove_word(line_att)
2356 : ELSE
2357 5585 : CALL parser_get_object(parser, hprj_ppnl(i, i, l))
2358 5585 : istr = LEN_TRIM(line_att) + 1
2359 5585 : WRITE (UNIT=line_att(istr:), FMT="(ES25.16E3)") hprj_ppnl(i, i, l)
2360 : END IF
2361 : ELSE
2362 1020 : IF (read_from_input) THEN
2363 50 : IF (LEN_TRIM(line_att) /= 0) THEN
2364 : CALL cp_abort(__LOCATION__, &
2365 0 : "Error while reading GTH potential from input file")
2366 : END IF
2367 50 : is_ok = cp_sll_val_next(list, val)
2368 50 : IF (.NOT. is_ok) THEN
2369 : CALL cp_abort(__LOCATION__, &
2370 0 : "Error while reading GTH potential from input file")
2371 : END IF
2372 50 : CALL val_get(val, c_val=line_att)
2373 50 : READ (line_att, *) hprj_ppnl(i, i, l)
2374 50 : CALL remove_word(line_att)
2375 : ELSE
2376 970 : IF (update_input) THEN
2377 970 : irep = irep + 1
2378 : CALL section_vals_val_set(potential_section, "_DEFAULT_KEYWORD_", i_rep_val=irep, &
2379 970 : c_val=TRIM(line_att))
2380 : END IF
2381 970 : line_att = ""
2382 970 : CALL parser_get_object(parser, hprj_ppnl(i, i, l), newline=.TRUE.)
2383 970 : istr = LEN_TRIM(line_att) + 1
2384 0 : WRITE (UNIT=line_att(istr:), FMT="(T36,A,ES25.16E3)") &
2385 27920 : REPEAT(" ", 25*(i - 1)), hprj_ppnl(i, i, l)
2386 : END IF
2387 : END IF
2388 17681 : DO j = i + 1, nprj_ppnl
2389 8063 : IF (read_from_input) THEN
2390 54 : READ (line_att, *) hprj_ppnl(i, j, l)
2391 54 : CALL remove_word(line_att)
2392 : ELSE
2393 1078 : CALL parser_get_object(parser, hprj_ppnl(i, j, l))
2394 1078 : istr = LEN_TRIM(line_att) + 1
2395 1078 : WRITE (UNIT=line_att(istr:), FMT="(ES25.16E3)") hprj_ppnl(i, j, l)
2396 : END IF
2397 : END DO
2398 : END DO
2399 9618 : IF (.NOT. read_from_input) THEN
2400 9058 : IF (update_input) THEN
2401 9002 : irep = irep + 1
2402 : CALL section_vals_val_set(potential_section, "_DEFAULT_KEYWORD_", i_rep_val=irep, &
2403 9002 : c_val=TRIM(line_att))
2404 : END IF
2405 9058 : line_att = ""
2406 : ELSE
2407 560 : IF (LEN_TRIM(line_att) /= 0) THEN
2408 : CALL cp_abort(__LOCATION__, &
2409 0 : "Error while reading GTH potential from input file")
2410 : END IF
2411 : END IF
2412 9618 : IF (nprj_ppnl > 1) THEN
2413 908 : CALL symmetrize_matrix(hprj_ppnl(:, :, l), "upper_to_lower")
2414 : END IF
2415 9618 : IF (potential%soc .AND. (l > 0)) THEN
2416 : ! Read non-local parameters for spin-orbit coupling
2417 262 : DO i = 1, nprj_ppnl
2418 150 : IF (read_from_input) THEN
2419 2 : IF (LEN_TRIM(line_att) /= 0) THEN
2420 : CALL cp_abort(__LOCATION__, &
2421 0 : "Error while reading GTH potential from input file")
2422 : END IF
2423 2 : is_ok = cp_sll_val_next(list, val)
2424 2 : IF (.NOT. is_ok) THEN
2425 : CALL cp_abort(__LOCATION__, &
2426 0 : "Error while reading GTH potential from input file")
2427 : END IF
2428 2 : CALL val_get(val, c_val=line_att)
2429 2 : READ (line_att, *) kprj_ppnl(i, i, l)
2430 2 : CALL remove_word(line_att)
2431 : ELSE
2432 148 : IF (i > 1 .AND. update_input) THEN
2433 38 : irep = irep + 1
2434 : CALL section_vals_val_set(potential_section, "_DEFAULT_KEYWORD_", i_rep_val=irep, &
2435 38 : c_val=TRIM(line_att))
2436 : END IF
2437 148 : line_att = ""
2438 148 : CALL parser_get_object(parser, kprj_ppnl(i, i, l), newline=.TRUE.)
2439 148 : istr = LEN_TRIM(line_att) + 1
2440 0 : WRITE (UNIT=line_att(istr:), FMT="(T36,A,ES25.16E3)") &
2441 1148 : REPEAT(" ", 25*(i - 1)), kprj_ppnl(i, i, l)
2442 : END IF
2443 302 : DO j = i + 1, nprj_ppnl
2444 190 : IF (read_from_input) THEN
2445 0 : READ (line_att, *) kprj_ppnl(i, j, l)
2446 0 : CALL remove_word(line_att)
2447 : ELSE
2448 40 : CALL parser_get_object(parser, kprj_ppnl(i, j, l))
2449 40 : istr = LEN_TRIM(line_att) + 1
2450 40 : WRITE (UNIT=line_att(istr:), FMT="(ES25.16E3)") kprj_ppnl(i, j, l)
2451 : END IF
2452 : END DO
2453 : END DO
2454 112 : IF (read_from_input) THEN
2455 2 : IF (LEN_TRIM(line_att) /= 0) THEN
2456 : CALL cp_abort(__LOCATION__, &
2457 0 : "Error while reading GTH potential from input file")
2458 : END IF
2459 : ELSE
2460 110 : IF (update_input) THEN
2461 110 : irep = irep + 1
2462 : CALL section_vals_val_set(potential_section, "_DEFAULT_KEYWORD_", i_rep_val=irep, &
2463 110 : c_val=TRIM(line_att))
2464 : END IF
2465 110 : line_att = ""
2466 : END IF
2467 112 : IF (nprj_ppnl > 1) THEN
2468 36 : CALL symmetrize_matrix(kprj_ppnl(:, :, l), "upper_to_lower")
2469 : END IF
2470 : END IF ! SOC
2471 14637 : lprj_ppnl_max = MAX(lprj_ppnl_max, l + 2*(nprj_ppnl - 1))
2472 : END DO ! lppnl
2473 :
2474 5019 : potential%nppnl = nppnl
2475 5019 : CALL init_orbital_pointers(lprj_ppnl_max)
2476 :
2477 5019 : potential%lprj_ppnl_max = lprj_ppnl_max
2478 5019 : potential%nprj_ppnl_max = nprj_ppnl_max
2479 : CALL reallocate(potential%hprj_ppnl, 1, nprj_ppnl_max, &
2480 : 1, nprj_ppnl_max, &
2481 5019 : 0, lppnl)
2482 41861 : potential%hprj_ppnl(:, :, :) = hprj_ppnl(:, :, :)
2483 : CALL reallocate(potential%kprj_ppnl, 1, nprj_ppnl_max, &
2484 : 1, nprj_ppnl_max, &
2485 5019 : 0, lppnl)
2486 41861 : potential%kprj_ppnl(:, :, :) = kprj_ppnl(:, :, :)
2487 :
2488 5019 : CALL reallocate(potential%cprj, 1, ncoset(lprj_ppnl_max), 1, nppnl)
2489 5019 : CALL reallocate(potential%cprj_ppnl, 1, nprj_ppnl_max, 0, lppnl)
2490 5019 : CALL reallocate(potential%vprj_ppnl, 1, nppnl, 1, nppnl)
2491 5019 : CALL reallocate(potential%wprj_ppnl, 1, nppnl, 1, nppnl)
2492 :
2493 5019 : DEALLOCATE (hprj_ppnl, kprj_ppnl)
2494 : END IF
2495 : EXIT search_loop
2496 : END IF
2497 : ELSE
2498 : ! Stop program, if the end of file is reached
2499 2 : IF (PRESENT(potential_found)) THEN
2500 2 : CALL parser_release(parser)
2501 2 : DEALLOCATE (parser)
2502 2 : RETURN
2503 : END IF
2504 : CALL cp_abort(__LOCATION__, &
2505 : "The requested atomic potential <"// &
2506 : TRIM(potential_name)// &
2507 : "> for element <"// &
2508 : TRIM(symbol)// &
2509 : "> was not found in the potential file <"// &
2510 0 : TRIM(potential_file_name)//">")
2511 : END IF
2512 : END DO search_loop
2513 :
2514 9971 : IF (PRESENT(potential_found)) potential_found = .TRUE.
2515 :
2516 9971 : IF (.NOT. read_from_input) THEN
2517 : ! Dump the potential info in the potential section
2518 9231 : IF (match .AND. update_input) THEN
2519 9177 : irep = irep + 1
2520 : WRITE (UNIT=line_att, FMT="(T9,A)") &
2521 : "# Potential name: "//TRIM(ADJUSTL(apname2(:strlen2)))// &
2522 9177 : " for element symbol: "//TRIM(ADJUSTL(symbol2(:strlen1)))
2523 : CALL section_vals_val_set(potential_section, "_DEFAULT_KEYWORD_", i_rep_val=irep, &
2524 9177 : c_val=TRIM(line_att))
2525 9177 : irep = irep + 1
2526 : WRITE (UNIT=line_att, FMT="(T9,A)") &
2527 9177 : "# Potential read from the potential filename: "//TRIM(ADJUSTL(potential_file_name))
2528 : CALL section_vals_val_set(potential_section, "_DEFAULT_KEYWORD_", i_rep_val=irep, &
2529 9177 : c_val=TRIM(line_att))
2530 : END IF
2531 9231 : CALL parser_release(parser)
2532 9231 : DEALLOCATE (parser)
2533 : END IF
2534 :
2535 9971 : IF (ASSOCIATED(tmp_vals)) DEALLOCATE (tmp_vals)
2536 :
2537 9973 : END SUBROUTINE read_gth_potential
2538 :
2539 : ! **************************************************************************************************
2540 : !> \brief Read a GTH potential from an ordered list of library files.
2541 : !> \param element_symbol ...
2542 : !> \param potential_name ...
2543 : !> \param potential ...
2544 : !> \param zeff_correction ...
2545 : !> \param para_env ...
2546 : !> \param potential_file_names ...
2547 : !> \param potential_section ...
2548 : !> \param update_input ...
2549 : !> \param monovalent ...
2550 : ! **************************************************************************************************
2551 9971 : SUBROUTINE read_gth_potential_files(element_symbol, potential_name, potential, zeff_correction, &
2552 9971 : para_env, potential_file_names, potential_section, update_input, &
2553 : monovalent)
2554 :
2555 : CHARACTER(LEN=*), INTENT(IN) :: element_symbol, potential_name
2556 : TYPE(gth_potential_type), INTENT(INOUT) :: potential
2557 : REAL(KIND=dp), INTENT(IN) :: zeff_correction
2558 : TYPE(mp_para_env_type), INTENT(IN), POINTER :: para_env
2559 : CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: potential_file_names
2560 : TYPE(section_vals_type), INTENT(IN), POINTER :: potential_section
2561 : LOGICAL, INTENT(IN) :: update_input
2562 : LOGICAL, INTENT(IN), OPTIONAL :: monovalent
2563 :
2564 : INTEGER :: i
2565 : LOGICAL :: potential_found
2566 :
2567 9973 : DO i = 1, SIZE(potential_file_names)
2568 : CALL read_gth_potential(element_symbol, potential_name, potential, zeff_correction, para_env, &
2569 : potential_file_names(i), potential_section, update_input, monovalent, &
2570 9973 : potential_found)
2571 9973 : IF (potential_found) RETURN
2572 : END DO
2573 0 : CALL potential_files_not_found(element_symbol, potential_name, potential_file_names)
2574 :
2575 : END SUBROUTINE read_gth_potential_files
2576 :
2577 : ! **************************************************************************************************
2578 : !> \brief ...
2579 : !> \param potential ...
2580 : !> \param z ...
2581 : !> \param zeff_correction ...
2582 : ! **************************************************************************************************
2583 5480 : SUBROUTINE set_default_all_potential(potential, z, zeff_correction)
2584 :
2585 : TYPE(all_potential_type), INTENT(INOUT) :: potential
2586 : INTEGER, INTENT(IN) :: z
2587 : REAL(KIND=dp), INTENT(IN) :: zeff_correction
2588 :
2589 : CHARACTER(LEN=default_string_length) :: name
2590 : INTEGER, DIMENSION(:), POINTER :: elec_conf
2591 : REAL(KIND=dp) :: alpha, alpha_core_charge, ccore_charge, &
2592 : core_charge_radius, r, zeff
2593 :
2594 0 : ALLOCATE (elec_conf(0:3))
2595 27400 : elec_conf(0:3) = ptable(z)%e_conv(0:3)
2596 27400 : zeff = REAL(SUM(elec_conf), dp) + zeff_correction
2597 5480 : name = ptable(z)%name
2598 :
2599 5480 : r = ptable(z)%covalent_radius*0.5_dp
2600 5480 : r = MAX(r, 0.2_dp)
2601 5480 : r = MIN(r, 1.0_dp)
2602 5480 : alpha = 1.0_dp/(2.0_dp*r**2)
2603 :
2604 5480 : core_charge_radius = r
2605 5480 : alpha_core_charge = alpha
2606 5480 : ccore_charge = zeff*SQRT((alpha/pi)**3)
2607 :
2608 : CALL set_all_potential(potential, &
2609 : name=name, &
2610 : alpha_core_charge=alpha_core_charge, &
2611 : ccore_charge=ccore_charge, &
2612 : core_charge_radius=core_charge_radius, &
2613 : z=z, &
2614 : zeff=zeff, &
2615 : zeff_correction=zeff_correction, &
2616 5480 : elec_conf=elec_conf)
2617 :
2618 5480 : DEALLOCATE (elec_conf)
2619 :
2620 5480 : END SUBROUTINE set_default_all_potential
2621 :
2622 : ! **************************************************************************************************
2623 : !> \brief Set the attributes of an all-electron potential data set.
2624 : !> \param potential ...
2625 : !> \param name ...
2626 : !> \param alpha_core_charge ...
2627 : !> \param ccore_charge ...
2628 : !> \param core_charge_radius ...
2629 : !> \param z ...
2630 : !> \param zeff ...
2631 : !> \param zeff_correction ...
2632 : !> \param elec_conf ...
2633 : !> \date 11.01.2002
2634 : !> \author MK
2635 : !> \version 1.0
2636 : ! **************************************************************************************************
2637 17118 : SUBROUTINE set_all_potential(potential, name, alpha_core_charge, &
2638 : ccore_charge, core_charge_radius, z, zeff, &
2639 : zeff_correction, elec_conf)
2640 :
2641 : TYPE(all_potential_type), INTENT(INOUT) :: potential
2642 : CHARACTER(LEN=default_string_length), INTENT(IN), &
2643 : OPTIONAL :: name
2644 : REAL(KIND=dp), INTENT(IN), OPTIONAL :: alpha_core_charge, ccore_charge, &
2645 : core_charge_radius
2646 : INTEGER, INTENT(IN), OPTIONAL :: z
2647 : REAL(KIND=dp), INTENT(IN), OPTIONAL :: zeff, zeff_correction
2648 : INTEGER, DIMENSION(:), OPTIONAL, POINTER :: elec_conf
2649 :
2650 17118 : IF (PRESENT(name)) potential%name = name
2651 17118 : IF (PRESENT(alpha_core_charge)) THEN
2652 5480 : potential%alpha_core_charge = alpha_core_charge
2653 : END IF
2654 17118 : IF (PRESENT(ccore_charge)) potential%ccore_charge = ccore_charge
2655 17118 : IF (PRESENT(core_charge_radius)) THEN
2656 12750 : potential%core_charge_radius = core_charge_radius
2657 : END IF
2658 17118 : IF (PRESENT(z)) potential%z = z
2659 17118 : IF (PRESENT(zeff)) potential%zeff = zeff
2660 17118 : IF (PRESENT(zeff_correction)) potential%zeff_correction = zeff_correction
2661 17118 : IF (PRESENT(elec_conf)) THEN
2662 5480 : IF (.NOT. ASSOCIATED(potential%elec_conf)) THEN
2663 5480 : CALL reallocate(potential%elec_conf, 0, SIZE(elec_conf) - 1)
2664 : END IF
2665 27400 : potential%elec_conf(:) = elec_conf(:)
2666 : END IF
2667 :
2668 17118 : END SUBROUTINE set_all_potential
2669 :
2670 : ! **************************************************************************************************
2671 : !> \brief Set the attributes of an atomic local potential data set.
2672 : !> \param potential ...
2673 : !> \param name ...
2674 : !> \param alpha ...
2675 : !> \param cval ...
2676 : !> \param radius ...
2677 : !> \date 24.01.2014
2678 : !> \author JGH
2679 : !> \version 1.0
2680 : ! **************************************************************************************************
2681 0 : SUBROUTINE set_local_potential(potential, name, alpha, cval, radius)
2682 :
2683 : TYPE(local_potential_type), INTENT(INOUT) :: potential
2684 : CHARACTER(LEN=default_string_length), INTENT(IN), &
2685 : OPTIONAL :: name
2686 : REAL(KIND=dp), DIMENSION(:), OPTIONAL, POINTER :: alpha
2687 : REAL(KIND=dp), DIMENSION(:, :), OPTIONAL, POINTER :: cval
2688 : REAL(KIND=dp), INTENT(IN), OPTIONAL :: radius
2689 :
2690 0 : IF (PRESENT(name)) potential%name = name
2691 0 : IF (PRESENT(alpha)) potential%alpha => alpha
2692 0 : IF (PRESENT(cval)) potential%cval => cval
2693 0 : IF (PRESENT(radius)) potential%radius = radius
2694 :
2695 0 : END SUBROUTINE set_local_potential
2696 :
2697 : ! **************************************************************************************************
2698 : !> \brief Set the attributes of an effective charge and inducible point
2699 : !> dipole potential data set.
2700 : !> \param potential ...
2701 : !> \param apol ...
2702 : !> \param cpol ...
2703 : !> \param qeff ...
2704 : !> \param mm_radius ...
2705 : !> \param qmmm_corr_radius ...
2706 : !> \param qmmm_radius ...
2707 : !> \date 05.03.2010
2708 : !> \author Toon.Verstraelen@gmail.com
2709 : ! **************************************************************************************************
2710 54229 : SUBROUTINE set_fist_potential(potential, apol, cpol, qeff, mm_radius, &
2711 : qmmm_corr_radius, qmmm_radius)
2712 :
2713 : TYPE(fist_potential_type), INTENT(INOUT) :: potential
2714 : REAL(KIND=dp), INTENT(IN), OPTIONAL :: apol, cpol, qeff, mm_radius, &
2715 : qmmm_corr_radius, qmmm_radius
2716 :
2717 54229 : IF (PRESENT(apol)) potential%apol = apol
2718 54229 : IF (PRESENT(cpol)) potential%cpol = cpol
2719 54229 : IF (PRESENT(mm_radius)) potential%mm_radius = mm_radius
2720 54229 : IF (PRESENT(qeff)) potential%qeff = qeff
2721 54229 : IF (PRESENT(qmmm_corr_radius)) potential%qmmm_corr_radius = qmmm_corr_radius
2722 54229 : IF (PRESENT(qmmm_radius)) potential%qmmm_radius = qmmm_radius
2723 :
2724 54229 : END SUBROUTINE set_fist_potential
2725 :
2726 : ! **************************************************************************************************
2727 : !> \brief Set the attributes of a GTH potential data set.
2728 : !> \param potential ...
2729 : !> \param name ...
2730 : !> \param alpha_core_charge ...
2731 : !> \param alpha_ppl ...
2732 : !> \param ccore_charge ...
2733 : !> \param cerf_ppl ...
2734 : !> \param core_charge_radius ...
2735 : !> \param ppl_radius ...
2736 : !> \param ppnl_radius ...
2737 : !> \param lppnl ...
2738 : !> \param lprj_ppnl_max ...
2739 : !> \param nexp_ppl ...
2740 : !> \param nppnl ...
2741 : !> \param nprj_ppnl_max ...
2742 : !> \param z ...
2743 : !> \param zeff ...
2744 : !> \param zeff_correction ...
2745 : !> \param alpha_ppnl ...
2746 : !> \param cexp_ppl ...
2747 : !> \param elec_conf ...
2748 : !> \param nprj_ppnl ...
2749 : !> \param cprj ...
2750 : !> \param cprj_ppnl ...
2751 : !> \param vprj_ppnl ...
2752 : !> \param wprj_ppnl ...
2753 : !> \param hprj_ppnl ...
2754 : !> \param kprj_ppnl ...
2755 : !> \date 11.01.2002
2756 : !> \author MK
2757 : !> \version 1.0
2758 : ! **************************************************************************************************
2759 25111 : SUBROUTINE set_gth_potential(potential, name, alpha_core_charge, alpha_ppl, &
2760 : ccore_charge, cerf_ppl, core_charge_radius, &
2761 : ppl_radius, ppnl_radius, lppnl, lprj_ppnl_max, &
2762 : nexp_ppl, nppnl, nprj_ppnl_max, z, zeff, zeff_correction, &
2763 : alpha_ppnl, cexp_ppl, elec_conf, nprj_ppnl, cprj, cprj_ppnl, &
2764 : vprj_ppnl, wprj_ppnl, hprj_ppnl, kprj_ppnl)
2765 :
2766 : TYPE(gth_potential_type), INTENT(INOUT) :: potential
2767 : CHARACTER(LEN=default_string_length), INTENT(IN), &
2768 : OPTIONAL :: name
2769 : REAL(KIND=dp), INTENT(IN), OPTIONAL :: alpha_core_charge, alpha_ppl, &
2770 : ccore_charge, cerf_ppl, &
2771 : core_charge_radius, ppl_radius, &
2772 : ppnl_radius
2773 : INTEGER, INTENT(IN), OPTIONAL :: lppnl, lprj_ppnl_max, nexp_ppl, nppnl, &
2774 : nprj_ppnl_max, z
2775 : REAL(KIND=dp), INTENT(IN), OPTIONAL :: zeff, zeff_correction
2776 : REAL(KIND=dp), DIMENSION(:), OPTIONAL, POINTER :: alpha_ppnl, cexp_ppl
2777 : INTEGER, DIMENSION(:), OPTIONAL, POINTER :: elec_conf, nprj_ppnl
2778 : REAL(KIND=dp), DIMENSION(:, :), OPTIONAL, POINTER :: cprj, cprj_ppnl, vprj_ppnl, wprj_ppnl
2779 : REAL(KIND=dp), DIMENSION(:, :, :), OPTIONAL, &
2780 : POINTER :: hprj_ppnl, kprj_ppnl
2781 :
2782 25111 : IF (PRESENT(name)) potential%name = name
2783 25111 : IF (PRESENT(alpha_core_charge)) THEN
2784 0 : potential%alpha_core_charge = alpha_core_charge
2785 : END IF
2786 25111 : IF (PRESENT(alpha_ppl)) potential%alpha_ppl = alpha_ppl
2787 25111 : IF (PRESENT(ccore_charge)) potential%ccore_charge = ccore_charge
2788 25111 : IF (PRESENT(cerf_ppl)) potential%cerf_ppl = cerf_ppl
2789 25111 : IF (PRESENT(core_charge_radius)) THEN
2790 15140 : potential%core_charge_radius = core_charge_radius
2791 : END IF
2792 25111 : IF (PRESENT(ppl_radius)) potential%ppl_radius = ppl_radius
2793 25111 : IF (PRESENT(ppnl_radius)) potential%ppnl_radius = ppnl_radius
2794 25111 : IF (PRESENT(lppnl)) potential%lppnl = lppnl
2795 25111 : IF (PRESENT(lprj_ppnl_max)) potential%lprj_ppnl_max = lprj_ppnl_max
2796 25111 : IF (PRESENT(nexp_ppl)) potential%nexp_ppl = nexp_ppl
2797 25111 : IF (PRESENT(nppnl)) potential%nppnl = nppnl
2798 25111 : IF (PRESENT(nprj_ppnl_max)) potential%nprj_ppnl_max = nprj_ppnl_max
2799 25111 : IF (PRESENT(z)) potential%z = z
2800 25111 : IF (PRESENT(zeff)) potential%zeff = zeff
2801 25111 : IF (PRESENT(zeff_correction)) potential%zeff_correction = zeff_correction
2802 25111 : IF (PRESENT(alpha_ppnl)) potential%alpha_ppnl => alpha_ppnl
2803 25111 : IF (PRESENT(cexp_ppl)) potential%cexp_ppl => cexp_ppl
2804 25111 : IF (PRESENT(elec_conf)) THEN
2805 0 : IF (ASSOCIATED(potential%elec_conf)) THEN
2806 0 : DEALLOCATE (potential%elec_conf)
2807 : END IF
2808 0 : ALLOCATE (potential%elec_conf(0:SIZE(elec_conf) - 1))
2809 0 : potential%elec_conf(:) = elec_conf(:)
2810 : END IF
2811 25111 : IF (PRESENT(nprj_ppnl)) potential%nprj_ppnl => nprj_ppnl
2812 25111 : IF (PRESENT(cprj)) potential%cprj => cprj
2813 25111 : IF (PRESENT(cprj_ppnl)) potential%cprj_ppnl => cprj_ppnl
2814 25111 : IF (PRESENT(hprj_ppnl)) potential%hprj_ppnl => hprj_ppnl
2815 25111 : IF (PRESENT(kprj_ppnl)) potential%kprj_ppnl => kprj_ppnl
2816 25111 : IF (PRESENT(vprj_ppnl)) potential%vprj_ppnl => vprj_ppnl
2817 25111 : IF (PRESENT(wprj_ppnl)) potential%wprj_ppnl => wprj_ppnl
2818 :
2819 25111 : END SUBROUTINE set_gth_potential
2820 :
2821 : ! **************************************************************************************************
2822 : !> \brief ...
2823 : !> \param potential ...
2824 : !> \param name ...
2825 : !> \param description ...
2826 : !> \param aliases ...
2827 : !> \param elec_conf ...
2828 : !> \param z ...
2829 : !> \param zeff ...
2830 : !> \param zeff_correction ...
2831 : !> \param alpha_core_charge ...
2832 : !> \param ccore_charge ...
2833 : !> \param core_charge_radius ...
2834 : !> \param ppl_radius ...
2835 : !> \param ppnl_radius ...
2836 : !> \param ecp_local ...
2837 : !> \param n_local ...
2838 : !> \param a_local ...
2839 : !> \param c_local ...
2840 : !> \param nloc ...
2841 : !> \param nrloc ...
2842 : !> \param aloc ...
2843 : !> \param bloc ...
2844 : !> \param ecp_semi_local ...
2845 : !> \param sl_lmax ...
2846 : !> \param npot ...
2847 : !> \param nrpot ...
2848 : !> \param apot ...
2849 : !> \param bpot ...
2850 : !> \param n_nonlocal ...
2851 : !> \param nppnl ...
2852 : !> \param lmax ...
2853 : !> \param is_nonlocal ...
2854 : !> \param a_nonlocal ...
2855 : !> \param h_nonlocal ...
2856 : !> \param c_nonlocal ...
2857 : !> \param has_nlcc ...
2858 : !> \param n_nlcc ...
2859 : !> \param a_nlcc ...
2860 : !> \param c_nlcc ...
2861 : ! **************************************************************************************************
2862 772 : SUBROUTINE set_sgp_potential(potential, name, description, aliases, elec_conf, &
2863 : z, zeff, zeff_correction, alpha_core_charge, &
2864 : ccore_charge, core_charge_radius, &
2865 : ppl_radius, ppnl_radius, &
2866 : ecp_local, n_local, a_local, c_local, &
2867 : nloc, nrloc, aloc, bloc, &
2868 : ecp_semi_local, sl_lmax, npot, nrpot, apot, bpot, &
2869 : n_nonlocal, nppnl, lmax, is_nonlocal, a_nonlocal, h_nonlocal, c_nonlocal, &
2870 : has_nlcc, n_nlcc, a_nlcc, c_nlcc)
2871 :
2872 : TYPE(sgp_potential_type), INTENT(INOUT) :: potential
2873 : CHARACTER(LEN=default_string_length), INTENT(IN), &
2874 : OPTIONAL :: name
2875 : CHARACTER(LEN=default_string_length), &
2876 : DIMENSION(4), INTENT(IN), OPTIONAL :: description
2877 : CHARACTER(LEN=default_string_length), INTENT(IN), &
2878 : OPTIONAL :: aliases
2879 : INTEGER, DIMENSION(:), OPTIONAL, POINTER :: elec_conf
2880 : INTEGER, INTENT(IN), OPTIONAL :: z
2881 : REAL(KIND=dp), INTENT(IN), OPTIONAL :: zeff, zeff_correction, &
2882 : alpha_core_charge, ccore_charge, &
2883 : core_charge_radius, ppl_radius, &
2884 : ppnl_radius
2885 : LOGICAL, INTENT(IN), OPTIONAL :: ecp_local
2886 : INTEGER, INTENT(IN), OPTIONAL :: n_local
2887 : REAL(KIND=dp), DIMENSION(:), OPTIONAL, POINTER :: a_local, c_local
2888 : INTEGER, INTENT(IN), OPTIONAL :: nloc
2889 : INTEGER, DIMENSION(1:10), INTENT(IN), OPTIONAL :: nrloc
2890 : REAL(dp), DIMENSION(1:10), INTENT(IN), OPTIONAL :: aloc, bloc
2891 : LOGICAL, INTENT(IN), OPTIONAL :: ecp_semi_local
2892 : INTEGER, INTENT(IN), OPTIONAL :: sl_lmax
2893 : INTEGER, DIMENSION(0:10), OPTIONAL :: npot
2894 : INTEGER, DIMENSION(1:15, 0:10), OPTIONAL :: nrpot
2895 : REAL(dp), DIMENSION(1:15, 0:10), OPTIONAL :: apot, bpot
2896 : INTEGER, INTENT(IN), OPTIONAL :: n_nonlocal, nppnl, lmax
2897 : LOGICAL, DIMENSION(0:5), INTENT(IN), OPTIONAL :: is_nonlocal
2898 : REAL(KIND=dp), DIMENSION(:), OPTIONAL, POINTER :: a_nonlocal
2899 : REAL(KIND=dp), DIMENSION(:, :), OPTIONAL, POINTER :: h_nonlocal
2900 : REAL(KIND=dp), DIMENSION(:, :, :), OPTIONAL, &
2901 : POINTER :: c_nonlocal
2902 : LOGICAL, INTENT(IN), OPTIONAL :: has_nlcc
2903 : INTEGER, INTENT(IN), OPTIONAL :: n_nlcc
2904 : REAL(KIND=dp), DIMENSION(:), OPTIONAL, POINTER :: a_nlcc, c_nlcc
2905 :
2906 772 : IF (PRESENT(name)) potential%name = name
2907 772 : IF (PRESENT(aliases)) potential%aliases = aliases
2908 1302 : IF (PRESENT(description)) potential%description = description
2909 :
2910 772 : IF (PRESENT(elec_conf)) THEN
2911 106 : IF (ASSOCIATED(potential%elec_conf)) THEN
2912 0 : DEALLOCATE (potential%elec_conf)
2913 : END IF
2914 318 : ALLOCATE (potential%elec_conf(0:SIZE(elec_conf) - 1))
2915 694 : potential%elec_conf(:) = elec_conf(:)
2916 : END IF
2917 :
2918 772 : IF (PRESENT(z)) potential%z = z
2919 772 : IF (PRESENT(zeff)) potential%zeff = zeff
2920 772 : IF (PRESENT(zeff_correction)) potential%zeff_correction = zeff_correction
2921 772 : IF (PRESENT(alpha_core_charge)) potential%alpha_core_charge = alpha_core_charge
2922 772 : IF (PRESENT(ccore_charge)) potential%ccore_charge = ccore_charge
2923 772 : IF (PRESENT(core_charge_radius)) potential%core_charge_radius = core_charge_radius
2924 :
2925 772 : IF (PRESENT(ppl_radius)) potential%ppl_radius = ppl_radius
2926 772 : IF (PRESENT(ppnl_radius)) potential%ppnl_radius = ppnl_radius
2927 :
2928 772 : IF (PRESENT(ecp_local)) potential%ecp_local = ecp_local
2929 772 : IF (PRESENT(n_local)) potential%n_local = n_local
2930 772 : IF (PRESENT(a_local)) potential%a_local => a_local
2931 772 : IF (PRESENT(c_local)) potential%c_local => c_local
2932 :
2933 772 : IF (PRESENT(nloc)) potential%nloc = nloc
2934 1674 : IF (PRESENT(nrloc)) potential%nrloc = nrloc
2935 1674 : IF (PRESENT(aloc)) potential%aloc = aloc
2936 1674 : IF (PRESENT(bloc)) potential%bloc = bloc
2937 :
2938 772 : IF (PRESENT(ecp_semi_local)) potential%ecp_semi_local = ecp_semi_local
2939 772 : IF (PRESENT(sl_lmax)) potential%sl_lmax = sl_lmax
2940 1756 : IF (PRESENT(npot)) potential%npot = npot
2941 15286 : IF (PRESENT(nrpot)) potential%nrpot = nrpot
2942 15286 : IF (PRESENT(apot)) potential%apot = apot
2943 15286 : IF (PRESENT(bpot)) potential%bpot = bpot
2944 :
2945 772 : IF (PRESENT(n_nonlocal)) potential%n_nonlocal = n_nonlocal
2946 772 : IF (PRESENT(nppnl)) potential%nppnl = nppnl
2947 772 : IF (PRESENT(lmax)) potential%lmax = lmax
2948 1514 : IF (PRESENT(is_nonlocal)) potential%is_nonlocal(:) = is_nonlocal(:)
2949 772 : IF (PRESENT(a_nonlocal)) potential%a_nonlocal => a_nonlocal
2950 772 : IF (PRESENT(c_nonlocal)) potential%c_nonlocal => c_nonlocal
2951 772 : IF (PRESENT(h_nonlocal)) potential%h_nonlocal => h_nonlocal
2952 :
2953 772 : IF (PRESENT(has_nlcc)) potential%has_nlcc = has_nlcc
2954 772 : IF (PRESENT(n_nlcc)) potential%n_nlcc = n_nlcc
2955 772 : IF (PRESENT(a_nlcc)) potential%a_nlcc => a_nlcc
2956 772 : IF (PRESENT(c_nlcc)) potential%c_nlcc => c_nlcc
2957 :
2958 772 : END SUBROUTINE set_sgp_potential
2959 :
2960 : ! **************************************************************************************************
2961 : !> \brief Write an atomic all-electron potential data set to the output unit
2962 : !> \param potential ...
2963 : !> \param output_unit ...
2964 : !> \par History
2965 : !> - Creation (09.02.2002, MK)
2966 : ! **************************************************************************************************
2967 1710 : SUBROUTINE write_all_potential(potential, output_unit)
2968 :
2969 : TYPE(all_potential_type), INTENT(IN) :: potential
2970 : INTEGER, INTENT(in) :: output_unit
2971 :
2972 : CHARACTER(LEN=20) :: string
2973 :
2974 1710 : IF (output_unit > 0) THEN
2975 : WRITE (UNIT=output_unit, FMT="(/,T6,A,T41,A40,/)") &
2976 1710 : "AE Potential information for", ADJUSTR(TRIM(potential%name))
2977 : WRITE (UNIT=output_unit, FMT="(T8,A,T41,A40)") &
2978 1710 : "Description: ", TRIM(potential%description(1)), &
2979 3420 : " ", TRIM(potential%description(2))
2980 : WRITE (UNIT=output_unit, FMT="(/,T8,A,T69,F12.6)") &
2981 1710 : "Gaussian exponent of the core charge distribution: ", &
2982 3420 : potential%alpha_core_charge
2983 8176 : WRITE (UNIT=string, FMT="(5I4)") potential%elec_conf
2984 : WRITE (UNIT=output_unit, FMT="(T8,A,T61,A20)") &
2985 1710 : "Electronic configuration (s p d ...):", &
2986 3420 : ADJUSTR(TRIM(string))
2987 : END IF
2988 :
2989 1710 : END SUBROUTINE write_all_potential
2990 :
2991 : ! **************************************************************************************************
2992 : !> \brief Write an atomic local potential data set to the output unit
2993 : !> \param potential ...
2994 : !> \param output_unit ...
2995 : !> \par History
2996 : !> - Creation (24.01.2014, JGH)
2997 : ! **************************************************************************************************
2998 4 : SUBROUTINE write_local_potential(potential, output_unit)
2999 :
3000 : TYPE(local_potential_type), INTENT(IN) :: potential
3001 : INTEGER, INTENT(in) :: output_unit
3002 :
3003 : INTEGER :: igau, ipol
3004 :
3005 4 : IF (output_unit > 0) THEN
3006 : WRITE (UNIT=output_unit, FMT="(/,T6,A,T41,A40)") &
3007 4 : "Local Potential information for", ADJUSTR(TRIM(potential%name))
3008 : WRITE (UNIT=output_unit, FMT="(T8,A,T41,A40)") &
3009 4 : "Description: ", TRIM(potential%description(1))
3010 12 : DO igau = 1, potential%ngau
3011 : WRITE (UNIT=output_unit, FMT="(T8,A,F12.6,T50,A,4(T68,I2,F10.4))") &
3012 8 : "Exponent: ", potential%alpha(igau), &
3013 28 : "Coefficients: ", (2*ipol - 2, potential%cval(igau, ipol), ipol=1, potential%npol)
3014 : END DO
3015 : END IF
3016 :
3017 4 : END SUBROUTINE write_local_potential
3018 :
3019 : ! **************************************************************************************************
3020 : !> \brief Write an atomic GTH potential data set to the output unit
3021 : !> \param potential ...
3022 : !> \param output_unit ...
3023 : !> \par History
3024 : !> - Creation (09.02.2002, MK)
3025 : ! **************************************************************************************************
3026 2284 : SUBROUTINE write_gth_potential(potential, output_unit)
3027 :
3028 : TYPE(gth_potential_type), INTENT(IN) :: potential
3029 : INTEGER, INTENT(in) :: output_unit
3030 :
3031 : CHARACTER(LEN=20) :: string
3032 : INTEGER :: i, j, l
3033 : REAL(KIND=dp) :: r
3034 :
3035 2284 : IF (output_unit > 0) THEN
3036 : WRITE (UNIT=output_unit, FMT="(/,T6,A,T41,A40,/)") &
3037 2284 : "GTH Potential information for", ADJUSTR(TRIM(potential%name))
3038 : WRITE (UNIT=output_unit, FMT="(T8,A,T41,A40)") &
3039 2284 : "Description: ", ADJUSTR(TRIM(potential%description(1))), &
3040 2284 : " ", ADJUSTR(TRIM(potential%description(2))), &
3041 2284 : " ", ADJUSTR(TRIM(potential%description(3))), &
3042 4568 : " ", ADJUSTR(TRIM(potential%description(4)))
3043 : WRITE (UNIT=output_unit, FMT="(/,T8,A,T69,F12.6)") &
3044 2284 : "Gaussian exponent of the core charge distribution: ", &
3045 4568 : potential%alpha_core_charge
3046 6464 : WRITE (UNIT=string, FMT="(5I4)") potential%elec_conf
3047 : WRITE (UNIT=output_unit, FMT="(T8,A,T61,A20)") &
3048 2284 : "Electronic configuration (s p d ...):", &
3049 4568 : ADJUSTR(TRIM(string))
3050 :
3051 2284 : r = 1.0_dp/SQRT(2.0_dp*potential%alpha_ppl)
3052 :
3053 : WRITE (UNIT=output_unit, FMT="(/,T8,A,/,/,T27,A,/,T21,5F12.6)") &
3054 2284 : "Parameters of the local part of the GTH pseudopotential:", &
3055 2284 : "rloc C1 C2 C3 C4", &
3056 8967 : r, (potential%cexp_ppl(i)*r**(2*(i - 1)), i=1, potential%nexp_ppl)
3057 :
3058 2284 : IF (potential%lppnl > -1) THEN
3059 1036 : IF (potential%soc) THEN
3060 : WRITE (UNIT=output_unit, FMT="(/,T8,A,/,/,(T20,A))") &
3061 5 : "Parameters of the non-local part of the GTH (SOC) pseudopotential:", &
3062 5 : "l r(l) h(i,j,l)", &
3063 10 : " k(i,j,l)"
3064 : ELSE
3065 : WRITE (UNIT=output_unit, FMT="(/,T8,A,/,/,T20,A,/)") &
3066 1031 : "Parameters of the non-local part of the GTH pseudopotential:", &
3067 2062 : "l r(l) h(i,j,l)"
3068 : END IF
3069 2975 : DO l = 0, potential%lppnl
3070 1939 : r = SQRT(0.5_dp/potential%alpha_ppnl(l))
3071 : WRITE (UNIT=output_unit, FMT="(T19,I2,5F12.6)") &
3072 3463 : l, r, (potential%hprj_ppnl(1, j, l), j=1, potential%nprj_ppnl(l))
3073 2198 : DO i = 2, potential%nprj_ppnl(l)
3074 : WRITE (UNIT=output_unit, FMT="(T33,4F12.6)") &
3075 2760 : (potential%hprj_ppnl(i, j, l), j=1, potential%nprj_ppnl(l))
3076 : END DO
3077 2975 : IF (potential%soc .AND. (l > 0)) THEN
3078 24 : DO i = 1, potential%nprj_ppnl(l)
3079 : WRITE (UNIT=output_unit, FMT="(T33,4F12.6)") &
3080 53 : (potential%kprj_ppnl(i, j, l), j=1, potential%nprj_ppnl(l))
3081 : END DO
3082 : END IF
3083 : END DO
3084 : END IF
3085 : END IF
3086 :
3087 2284 : END SUBROUTINE write_gth_potential
3088 :
3089 : ! **************************************************************************************************
3090 : !> \brief ...
3091 : !> \param potential ...
3092 : !> \param output_unit ...
3093 : ! **************************************************************************************************
3094 14 : SUBROUTINE write_sgp_potential(potential, output_unit)
3095 :
3096 : TYPE(sgp_potential_type), INTENT(IN) :: potential
3097 : INTEGER, INTENT(in) :: output_unit
3098 :
3099 : CHARACTER(LEN=40) :: string
3100 : INTEGER :: i, l
3101 : CHARACTER(LEN=1), DIMENSION(0:10), PARAMETER :: &
3102 : slqval = ["s", "p", "d", "f", "g", "h", "j", "k", "l", "m", "n"]
3103 :
3104 14 : IF (output_unit > 0) THEN
3105 : WRITE (UNIT=output_unit, FMT="(/,T6,A,T41,A40,/)") &
3106 14 : "SGP Potential information for", ADJUSTR(TRIM(potential%name))
3107 : WRITE (UNIT=output_unit, FMT="(T8,A,T25,A56)") &
3108 14 : "Description: ", ADJUSTR(TRIM(potential%description(1))), &
3109 14 : " ", ADJUSTR(TRIM(potential%description(2))), &
3110 14 : " ", ADJUSTR(TRIM(potential%description(3))), &
3111 28 : " ", ADJUSTR(TRIM(potential%description(4)))
3112 : WRITE (UNIT=output_unit, FMT="(/,T8,A,T69,F12.6)") &
3113 14 : "Gaussian exponent of the core charge distribution: ", &
3114 28 : potential%alpha_core_charge
3115 86 : WRITE (UNIT=string, FMT="(10I4)") potential%elec_conf
3116 : WRITE (UNIT=output_unit, FMT="(T8,A,T61,A20)") &
3117 14 : "Electronic configuration (s p d ...):", &
3118 28 : ADJUSTR(TRIM(string))
3119 14 : IF (potential%ecp_local) THEN
3120 8 : IF (potential%nloc > 0) THEN
3121 8 : WRITE (UNIT=output_unit, FMT="(/,T8,'Local pseudopotential')")
3122 8 : WRITE (UNIT=output_unit, FMT="(T20,'r**(n-2)',T50,'Coefficient',T73,'Exponent')")
3123 34 : DO i = 1, potential%nloc
3124 : WRITE (UNIT=output_unit, FMT="(T20,I5,T47,F14.8,T69,F12.6)") &
3125 34 : potential%nrloc(i), potential%aloc(i), potential%bloc(i)
3126 : END DO
3127 : END IF
3128 : ELSE
3129 6 : IF (ALLOCATED(potential%upf_data)) THEN
3130 6 : WRITE (UNIT=output_unit, FMT="(/,T8,A)") 'Local UPF potential: original radial table'
3131 6 : WRITE (UNIT=output_unit, FMT="(T8,A)") 'Gaussian core electrostatics and direct short-range quadrature'
3132 0 : ELSE IF (potential%n_local > 0) THEN
3133 0 : WRITE (UNIT=output_unit, FMT="(/,T8,'Local pseudopotential')")
3134 : WRITE (UNIT=output_unit, FMT="(T8,A,10(T21,6F10.4,/))") &
3135 0 : 'Exponents:', potential%a_local(1:potential%n_local)
3136 : WRITE (UNIT=output_unit, FMT="(T8,A,10(T21,6F10.4,/))") &
3137 0 : 'Coefficients:', potential%c_local(1:potential%n_local)
3138 : END IF
3139 : END IF
3140 14 : IF (potential%ecp_semi_local) THEN
3141 8 : WRITE (UNIT=output_unit, FMT="(/,T8,'Semi-local pseudopotential')")
3142 34 : DO l = 0, potential%sl_lmax
3143 26 : WRITE (UNIT=output_unit, FMT="(T8,A,A)") 'l-value: ', slqval(l)
3144 136 : DO i = 1, potential%npot(l)
3145 : WRITE (UNIT=output_unit, FMT="(T21,I5,2F20.8)") &
3146 128 : potential%nrpot(i, l), potential%bpot(i, l), potential%apot(i, l)
3147 : END DO
3148 : END DO
3149 : END IF
3150 : ! nonlocal PP
3151 14 : IF (ALLOCATED(potential%upf_data)) THEN
3152 6 : WRITE (UNIT=output_unit, FMT="(/,T8,A)") 'Nonlocal UPF potential: original radial projectors'
3153 6 : WRITE (UNIT=output_unit, FMT="(T8,A,T71,I10)") 'Total number of projectors:', potential%nppnl
3154 6 : WRITE (UNIT=output_unit, FMT="(T8,A)") 'Analytic angular integration and radial mesh quadrature'
3155 8 : ELSE IF (potential%n_nonlocal > 0) THEN
3156 0 : WRITE (UNIT=output_unit, FMT="(/,T8,'Nonlocal pseudopotential')")
3157 0 : WRITE (UNIT=output_unit, FMT="(T8,A,T71,I10)") 'Total number of projectors:', potential%nppnl
3158 : WRITE (UNIT=output_unit, FMT="(T8,A,10(T21,6F10.4,/))") &
3159 0 : 'Exponents:', potential%a_nonlocal(1:potential%n_nonlocal)
3160 0 : DO l = 0, potential%lmax
3161 0 : WRITE (UNIT=output_unit, FMT="(T8,'Coupling for l=',I4)") l
3162 : WRITE (UNIT=output_unit, FMT="(10(T21,6F10.4,/))") &
3163 0 : potential%h_nonlocal(1:potential%n_nonlocal, l)
3164 : END DO
3165 : END IF
3166 : !
3167 14 : IF (potential%has_nlcc) THEN
3168 3 : WRITE (UNIT=output_unit, FMT="(/,T8,'Nonlinear Core Correction')")
3169 : WRITE (UNIT=output_unit, FMT="(T8,A,10(T21,6F10.4,/))") &
3170 3 : 'Exponents:', potential%a_nlcc(1:potential%n_nlcc)
3171 : WRITE (UNIT=output_unit, FMT="(T8,A,10(T21,6F10.4,/))") &
3172 3 : 'Coefficients:', potential%c_nlcc(1:potential%n_nlcc)
3173 : END IF
3174 : END IF
3175 :
3176 14 : END SUBROUTINE write_sgp_potential
3177 :
3178 : ! **************************************************************************************************
3179 : !> \brief Copy an all_potential_type to a new, unallocated variable
3180 : !> \param pot_in the input potential to copy
3181 : !> \param pot_out the newly copied and allocated potential
3182 : !> \par History
3183 : !> - Creation (12.2019, A. Bussy)
3184 : ! **************************************************************************************************
3185 76 : SUBROUTINE copy_all_potential(pot_in, pot_out)
3186 :
3187 : TYPE(all_potential_type), INTENT(IN) :: pot_in
3188 : TYPE(all_potential_type), INTENT(INOUT), POINTER :: pot_out
3189 :
3190 76 : CALL allocate_all_potential(pot_out)
3191 :
3192 76 : pot_out%name = pot_in%name
3193 76 : pot_out%alpha_core_charge = pot_in%alpha_core_charge
3194 76 : pot_out%ccore_charge = pot_in%ccore_charge
3195 76 : pot_out%core_charge_radius = pot_in%core_charge_radius
3196 76 : pot_out%zeff = pot_in%zeff
3197 76 : pot_out%zeff_correction = pot_in%zeff_correction
3198 76 : pot_out%z = pot_in%z
3199 :
3200 76 : IF (ASSOCIATED(pot_in%elec_conf)) THEN
3201 228 : ALLOCATE (pot_out%elec_conf(LBOUND(pot_in%elec_conf, 1):UBOUND(pot_in%elec_conf, 1)))
3202 304 : pot_out%elec_conf(:) = pot_in%elec_conf(:)
3203 : END IF
3204 :
3205 76 : END SUBROUTINE copy_all_potential
3206 :
3207 : ! **************************************************************************************************
3208 : !> \brief Copy a gth_potential_type to a new, unallocated variable
3209 : !> \param pot_in the input potential to copy
3210 : !> \param pot_out the newly copied and allocated potential
3211 : !> \par History
3212 : !> - Creation (12.2019, A. Bussy)
3213 : ! **************************************************************************************************
3214 216 : SUBROUTINE copy_gth_potential(pot_in, pot_out)
3215 :
3216 : TYPE(gth_potential_type), INTENT(IN) :: pot_in
3217 : TYPE(gth_potential_type), INTENT(INOUT), POINTER :: pot_out
3218 :
3219 216 : CALL allocate_gth_potential(pot_out)
3220 :
3221 216 : pot_out%name = pot_in%name
3222 216 : pot_out%aliases = pot_in%aliases
3223 216 : pot_out%alpha_core_charge = pot_in%alpha_core_charge
3224 216 : pot_out%alpha_ppl = pot_in%alpha_ppl
3225 216 : pot_out%ccore_charge = pot_in%ccore_charge
3226 216 : pot_out%cerf_ppl = pot_in%cerf_ppl
3227 216 : pot_out%zeff = pot_in%zeff
3228 216 : pot_out%core_charge_radius = pot_in%core_charge_radius
3229 216 : pot_out%ppl_radius = pot_in%ppl_radius
3230 216 : pot_out%ppnl_radius = pot_in%ppnl_radius
3231 216 : pot_out%zeff_correction = pot_in%zeff_correction
3232 216 : pot_out%lppnl = pot_in%lppnl
3233 216 : pot_out%lprj_ppnl_max = pot_in%lprj_ppnl_max
3234 216 : pot_out%nexp_ppl = pot_in%nexp_ppl
3235 216 : pot_out%nppnl = pot_in%nppnl
3236 216 : pot_out%nprj_ppnl_max = pot_in%nprj_ppnl_max
3237 216 : pot_out%z = pot_in%z
3238 216 : pot_out%nlcc = pot_in%nlcc
3239 216 : pot_out%nexp_nlcc = pot_in%nexp_nlcc
3240 216 : pot_out%lsdpot = pot_in%lsdpot
3241 216 : pot_out%nexp_lsd = pot_in%nexp_lsd
3242 216 : pot_out%lpotextended = pot_in%lpotextended
3243 216 : pot_out%nexp_lpot = pot_in%nexp_lpot
3244 :
3245 216 : IF (ASSOCIATED(pot_in%alpha_ppnl)) THEN
3246 360 : ALLOCATE (pot_out%alpha_ppnl(LBOUND(pot_in%alpha_ppnl, 1):UBOUND(pot_in%alpha_ppnl, 1)))
3247 330 : pot_out%alpha_ppnl(:) = pot_in%alpha_ppnl(:)
3248 : END IF
3249 216 : IF (ASSOCIATED(pot_in%cexp_ppl)) THEN
3250 648 : ALLOCATE (pot_out%cexp_ppl(LBOUND(pot_in%cexp_ppl, 1):UBOUND(pot_in%cexp_ppl, 1)))
3251 648 : pot_out%cexp_ppl(:) = pot_in%cexp_ppl(:)
3252 : END IF
3253 216 : IF (ASSOCIATED(pot_in%elec_conf)) THEN
3254 648 : ALLOCATE (pot_out%elec_conf(LBOUND(pot_in%elec_conf, 1):UBOUND(pot_in%elec_conf, 1)))
3255 650 : pot_out%elec_conf(:) = pot_in%elec_conf(:)
3256 : END IF
3257 216 : IF (ASSOCIATED(pot_in%nprj_ppnl)) THEN
3258 360 : ALLOCATE (pot_out%nprj_ppnl(LBOUND(pot_in%nprj_ppnl, 1):UBOUND(pot_in%nprj_ppnl, 1)))
3259 330 : pot_out%nprj_ppnl(:) = pot_in%nprj_ppnl(:)
3260 : END IF
3261 216 : IF (ASSOCIATED(pot_in%cprj)) THEN
3262 : ALLOCATE (pot_out%cprj(LBOUND(pot_in%cprj, 1):UBOUND(pot_in%cprj, 1), &
3263 480 : LBOUND(pot_in%cprj, 2):UBOUND(pot_in%cprj, 2)))
3264 396 : pot_out%cprj(:, :) = pot_in%cprj(:, :)
3265 : END IF
3266 216 : IF (ASSOCIATED(pot_in%cprj_ppnl)) THEN
3267 : ALLOCATE (pot_out%cprj_ppnl(LBOUND(pot_in%cprj_ppnl, 1):UBOUND(pot_in%cprj_ppnl, 1), &
3268 480 : LBOUND(pot_in%cprj_ppnl, 2):UBOUND(pot_in%cprj_ppnl, 2)))
3269 540 : pot_out%cprj_ppnl(:, :) = pot_in%cprj_ppnl(:, :)
3270 : END IF
3271 216 : IF (ASSOCIATED(pot_in%hprj_ppnl)) THEN
3272 : ALLOCATE (pot_out%hprj_ppnl(LBOUND(pot_in%hprj_ppnl, 1):UBOUND(pot_in%hprj_ppnl, 1), &
3273 : LBOUND(pot_in%hprj_ppnl, 2):UBOUND(pot_in%hprj_ppnl, 2), &
3274 600 : LBOUND(pot_in%hprj_ppnl, 3):UBOUND(pot_in%hprj_ppnl, 3)))
3275 750 : pot_out%hprj_ppnl(:, :, :) = pot_in%hprj_ppnl(:, :, :)
3276 : END IF
3277 216 : IF (ASSOCIATED(pot_in%kprj_ppnl)) THEN
3278 : ALLOCATE (pot_out%kprj_ppnl(LBOUND(pot_in%kprj_ppnl, 1):UBOUND(pot_in%kprj_ppnl, 1), &
3279 : LBOUND(pot_in%kprj_ppnl, 2):UBOUND(pot_in%kprj_ppnl, 2), &
3280 600 : LBOUND(pot_in%kprj_ppnl, 3):UBOUND(pot_in%kprj_ppnl, 3)))
3281 750 : pot_out%kprj_ppnl(:, :, :) = pot_in%kprj_ppnl(:, :, :)
3282 : END IF
3283 216 : IF (ASSOCIATED(pot_in%vprj_ppnl)) THEN
3284 : ALLOCATE (pot_out%vprj_ppnl(LBOUND(pot_in%vprj_ppnl, 1):UBOUND(pot_in%vprj_ppnl, 1), &
3285 480 : LBOUND(pot_in%vprj_ppnl, 2):UBOUND(pot_in%vprj_ppnl, 2)))
3286 396 : pot_out%vprj_ppnl(:, :) = pot_in%vprj_ppnl(:, :)
3287 : END IF
3288 216 : IF (ASSOCIATED(pot_in%wprj_ppnl)) THEN
3289 : ALLOCATE (pot_out%wprj_ppnl(LBOUND(pot_in%wprj_ppnl, 1):UBOUND(pot_in%wprj_ppnl, 1), &
3290 480 : LBOUND(pot_in%wprj_ppnl, 2):UBOUND(pot_in%wprj_ppnl, 2)))
3291 396 : pot_out%wprj_ppnl(:, :) = pot_in%wprj_ppnl(:, :)
3292 : END IF
3293 216 : IF (ASSOCIATED(pot_in%alpha_nlcc)) THEN
3294 12 : ALLOCATE (pot_out%alpha_nlcc(LBOUND(pot_in%alpha_nlcc, 1):UBOUND(pot_in%alpha_nlcc, 1)))
3295 8 : pot_out%alpha_nlcc(:) = pot_in%alpha_nlcc(:)
3296 : END IF
3297 216 : IF (ASSOCIATED(pot_in%nct_nlcc)) THEN
3298 12 : ALLOCATE (pot_out%nct_nlcc(LBOUND(pot_in%nct_nlcc, 1):UBOUND(pot_in%nct_nlcc, 1)))
3299 8 : pot_out%nct_nlcc(:) = pot_in%nct_nlcc(:)
3300 : END IF
3301 216 : IF (ASSOCIATED(pot_in%cval_nlcc)) THEN
3302 : ALLOCATE (pot_out%cval_nlcc(LBOUND(pot_in%cval_nlcc, 1):UBOUND(pot_in%cval_nlcc, 1), &
3303 16 : LBOUND(pot_in%cval_nlcc, 2):UBOUND(pot_in%cval_nlcc, 2)))
3304 24 : pot_out%cval_nlcc(:, :) = pot_in%cval_nlcc(:, :)
3305 : END IF
3306 216 : IF (ASSOCIATED(pot_in%alpha_lsd)) THEN
3307 0 : ALLOCATE (pot_out%alpha_lsd(LBOUND(pot_in%alpha_lsd, 1):UBOUND(pot_in%alpha_lsd, 1)))
3308 0 : pot_out%alpha_lsd(:) = pot_in%alpha_lsd(:)
3309 : END IF
3310 216 : IF (ASSOCIATED(pot_in%nct_lsd)) THEN
3311 0 : ALLOCATE (pot_out%nct_lsd(LBOUND(pot_in%nct_lsd, 1):UBOUND(pot_in%nct_lsd, 1)))
3312 0 : pot_out%nct_lsd(:) = pot_in%nct_lsd(:)
3313 : END IF
3314 216 : IF (ASSOCIATED(pot_in%cval_lsd)) THEN
3315 : ALLOCATE (pot_out%cval_lsd(LBOUND(pot_in%cval_lsd, 1):UBOUND(pot_in%cval_lsd, 1), &
3316 0 : LBOUND(pot_in%cval_lsd, 2):UBOUND(pot_in%cval_lsd, 2)))
3317 0 : pot_out%cval_lsd(:, :) = pot_in%cval_lsd(:, :)
3318 : END IF
3319 216 : IF (ASSOCIATED(pot_in%alpha_lpot)) THEN
3320 0 : ALLOCATE (pot_out%alpha_lpot(LBOUND(pot_in%alpha_lpot, 1):UBOUND(pot_in%alpha_lpot, 1)))
3321 0 : pot_out%alpha_lpot(:) = pot_in%alpha_lpot(:)
3322 : END IF
3323 216 : IF (ASSOCIATED(pot_in%nct_lpot)) THEN
3324 0 : ALLOCATE (pot_out%nct_lpot(LBOUND(pot_in%nct_lpot, 1):UBOUND(pot_in%nct_lpot, 1)))
3325 0 : pot_out%nct_lpot(:) = pot_in%nct_lpot(:)
3326 : END IF
3327 216 : IF (ASSOCIATED(pot_in%cval_lpot)) THEN
3328 : ALLOCATE (pot_out%cval_lpot(LBOUND(pot_in%cval_lpot, 1):UBOUND(pot_in%cval_lpot, 1), &
3329 0 : LBOUND(pot_in%cval_lpot, 2):UBOUND(pot_in%cval_lpot, 2)))
3330 0 : pot_out%cval_lpot(:, :) = pot_in%cval_lpot(:, :)
3331 : END IF
3332 :
3333 216 : END SUBROUTINE copy_gth_potential
3334 :
3335 : ! **************************************************************************************************
3336 : !> \brief Copy a sgp_potential_type to a new, unallocated variable
3337 : !> \param pot_in the input potential to copy
3338 : !> \param pot_out the newly copied and allocated potential
3339 : !> \par History
3340 : !> - Creation (12.2019, A. Bussy)
3341 : ! **************************************************************************************************
3342 0 : SUBROUTINE copy_sgp_potential(pot_in, pot_out)
3343 :
3344 : TYPE(sgp_potential_type), INTENT(IN) :: pot_in
3345 : TYPE(sgp_potential_type), INTENT(INOUT), POINTER :: pot_out
3346 :
3347 0 : CALL allocate_sgp_potential(pot_out)
3348 :
3349 0 : pot_out%name = pot_in%name
3350 0 : pot_out%aliases = pot_in%aliases
3351 0 : pot_out%z = pot_in%z
3352 0 : pot_out%zeff = pot_in%zeff
3353 0 : pot_out%zeff_correction = pot_in%zeff_correction
3354 0 : pot_out%alpha_core_charge = pot_in%alpha_core_charge
3355 0 : pot_out%ccore_charge = pot_in%ccore_charge
3356 0 : pot_out%core_charge_radius = pot_in%core_charge_radius
3357 0 : pot_out%ppl_radius = pot_in%ppl_radius
3358 0 : pot_out%ppnl_radius = pot_in%ppnl_radius
3359 0 : pot_out%ecp_local = pot_in%ecp_local
3360 0 : pot_out%n_local = pot_in%n_local
3361 0 : pot_out%nloc = pot_in%nloc
3362 0 : pot_out%nrloc = pot_in%nrloc
3363 0 : pot_out%aloc = pot_in%aloc
3364 0 : pot_out%bloc = pot_in%bloc
3365 0 : pot_out%ecp_semi_local = pot_in%ecp_semi_local
3366 0 : pot_out%sl_lmax = pot_in%sl_lmax
3367 0 : pot_out%npot = pot_in%npot
3368 0 : pot_out%nrpot = pot_in%nrpot
3369 0 : pot_out%apot = pot_in%apot
3370 0 : pot_out%bpot = pot_in%bpot
3371 0 : pot_out%n_nonlocal = pot_in%n_nonlocal
3372 0 : pot_out%nppnl = pot_in%nppnl
3373 0 : pot_out%lmax = pot_in%lmax
3374 0 : pot_out%is_nonlocal = pot_in%is_nonlocal
3375 0 : pot_out%has_nlcc = pot_in%has_nlcc
3376 0 : pot_out%n_nlcc = pot_in%n_nlcc
3377 0 : IF (ALLOCATED(pot_in%upf_data)) THEN
3378 0 : pot_out%upf_data = pot_in%upf_data
3379 0 : pot_out%upf_projectors = pot_in%upf_projectors
3380 0 : pot_out%upf_local = pot_in%upf_local
3381 : END IF
3382 :
3383 0 : IF (ASSOCIATED(pot_in%elec_conf)) THEN
3384 0 : ALLOCATE (pot_out%elec_conf(LBOUND(pot_in%elec_conf, 1):UBOUND(pot_in%elec_conf, 1)))
3385 0 : pot_out%elec_conf(:) = pot_in%elec_conf(:)
3386 : END IF
3387 0 : IF (ASSOCIATED(pot_in%a_local)) THEN
3388 0 : ALLOCATE (pot_out%a_local(LBOUND(pot_in%a_local, 1):UBOUND(pot_in%a_local, 1)))
3389 0 : pot_out%a_local(:) = pot_in%a_local(:)
3390 : END IF
3391 0 : IF (ASSOCIATED(pot_in%c_local)) THEN
3392 0 : ALLOCATE (pot_out%c_local(LBOUND(pot_in%c_local, 1):UBOUND(pot_in%c_local, 1)))
3393 0 : pot_out%c_local(:) = pot_in%c_local(:)
3394 : END IF
3395 0 : IF (ASSOCIATED(pot_in%a_nonlocal)) THEN
3396 0 : ALLOCATE (pot_out%a_nonlocal(LBOUND(pot_in%a_nonlocal, 1):UBOUND(pot_in%a_nonlocal, 1)))
3397 0 : pot_out%a_nonlocal(:) = pot_in%a_nonlocal(:)
3398 : END IF
3399 0 : IF (ASSOCIATED(pot_in%h_nonlocal)) THEN
3400 : ALLOCATE (pot_out%h_nonlocal(LBOUND(pot_in%h_nonlocal, 1):UBOUND(pot_in%h_nonlocal, 1), &
3401 0 : LBOUND(pot_in%h_nonlocal, 2):UBOUND(pot_in%h_nonlocal, 2)))
3402 0 : pot_out%h_nonlocal(:, :) = pot_in%h_nonlocal(:, :)
3403 : END IF
3404 0 : IF (ASSOCIATED(pot_in%c_nonlocal)) THEN
3405 : ALLOCATE (pot_out%c_nonlocal(LBOUND(pot_in%c_nonlocal, 1):UBOUND(pot_in%c_nonlocal, 1), &
3406 : LBOUND(pot_in%c_nonlocal, 2):UBOUND(pot_in%c_nonlocal, 2), &
3407 0 : LBOUND(pot_in%c_nonlocal, 3):UBOUND(pot_in%c_nonlocal, 3)))
3408 0 : pot_out%c_nonlocal(:, :, :) = pot_in%c_nonlocal(:, :, :)
3409 : END IF
3410 0 : IF (ASSOCIATED(pot_in%cprj_ppnl)) THEN
3411 : ALLOCATE (pot_out%cprj_ppnl(LBOUND(pot_in%cprj_ppnl, 1):UBOUND(pot_in%cprj_ppnl, 1), &
3412 0 : LBOUND(pot_in%cprj_ppnl, 2):UBOUND(pot_in%cprj_ppnl, 2)))
3413 0 : pot_out%cprj_ppnl(:, :) = pot_in%cprj_ppnl(:, :)
3414 : END IF
3415 0 : IF (ASSOCIATED(pot_in%vprj_ppnl)) THEN
3416 0 : ALLOCATE (pot_out%vprj_ppnl(LBOUND(pot_in%vprj_ppnl, 1):UBOUND(pot_in%vprj_ppnl, 1)))
3417 0 : pot_out%vprj_ppnl(:) = pot_in%vprj_ppnl(:)
3418 : END IF
3419 0 : IF (ASSOCIATED(pot_in%a_nlcc)) THEN
3420 0 : ALLOCATE (pot_out%a_nlcc(LBOUND(pot_in%a_nlcc, 1):UBOUND(pot_in%a_nlcc, 1)))
3421 0 : pot_out%a_nlcc(:) = pot_in%a_nlcc(:)
3422 : END IF
3423 0 : IF (ASSOCIATED(pot_in%c_nlcc)) THEN
3424 0 : ALLOCATE (pot_out%c_nlcc(LBOUND(pot_in%c_nlcc, 1):UBOUND(pot_in%c_nlcc, 1)))
3425 0 : pot_out%c_nlcc(:) = pot_in%c_nlcc(:)
3426 : END IF
3427 :
3428 0 : END SUBROUTINE copy_sgp_potential
3429 :
3430 0 : END MODULE external_potential_types
|
