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