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