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