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