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