Loading [MathJax]/extensions/tex2jax.js
 (git:b77b4be)
•All Data Structures Namespaces Files Functions Variables Typedefs Enumerations Enumerator Macros
external_potential_types.F
Go to the documentation of this file.
1!--------------------------------------------------------------------------------------------------!
2! CP2K: A general program to perform molecular dynamics simulations !
3! Copyright 2000-2025 CP2K developers group <https://cp2k.org> !
4! !
5! SPDX-License-Identifier: GPL-2.0-or-later !
6!--------------------------------------------------------------------------------------------------!
7
8! **************************************************************************************************
9!> \brief Definition of the atomic potential types.
10!> \par History
11!> GT, 22.09.2002: added elp_potential_types
12!> \author Matthias Krack (04.07.2000)
13! **************************************************************************************************
14MODULE 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
317CONTAINS
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 SUBROUTINE allocate_all_potential(potential)
327 TYPE(all_potential_type), INTENT(INOUT), POINTER :: potential
328
329 IF (ASSOCIATED(potential)) CALL deallocate_potential(potential)
330
331 ALLOCATE (potential)
332
333 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 SUBROUTINE allocate_fist_potential(potential)
342 TYPE(fist_potential_type), INTENT(INOUT), POINTER :: potential
343
344 IF (ASSOCIATED(potential)) CALL deallocate_potential(potential)
345
346 ALLOCATE (potential)
347
348 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 SUBROUTINE allocate_local_potential(potential)
358 TYPE(local_potential_type), INTENT(INOUT), POINTER :: potential
359
360 IF (ASSOCIATED(potential)) CALL deallocate_potential(potential)
361
362 ALLOCATE (potential)
363
364 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 SUBROUTINE allocate_gth_potential(potential)
374 TYPE(gth_potential_type), INTENT(INOUT), POINTER :: potential
375
376 IF (ASSOCIATED(potential)) CALL deallocate_potential(potential)
377
378 ALLOCATE (potential)
379
380 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 SUBROUTINE allocate_sgp_potential(potential)
388 TYPE(sgp_potential_type), INTENT(INOUT), POINTER :: potential
389
390 IF (ASSOCIATED(potential)) CALL deallocate_potential(potential)
391
392 ALLOCATE (potential)
393
394 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 SUBROUTINE deallocate_all_potential(potential)
403 TYPE(all_potential_type), POINTER :: potential
404
405 IF (.NOT. ASSOCIATED(potential)) THEN
406 cpabort("The pointer potential is not associated.")
407 END IF
408
409 DEALLOCATE (potential%elec_conf)
410 DEALLOCATE (potential)
411
412 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 SUBROUTINE deallocate_fist_potential(potential)
421 TYPE(fist_potential_type), POINTER :: potential
422
423 IF (.NOT. ASSOCIATED(potential)) THEN
424 cpabort("The pointer potential is not associated.")
425 END IF
426
427 ! Nothing exciting here yet.
428 DEALLOCATE (potential)
429
430 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 SUBROUTINE deallocate_local_potential(potential)
440 TYPE(local_potential_type), POINTER :: potential
441
442 IF (.NOT. ASSOCIATED(potential)) THEN
443 cpabort("The pointer potential is not associated.")
444 END IF
445
446 IF (ASSOCIATED(potential%alpha)) THEN
447 DEALLOCATE (potential%alpha)
448 END IF
449 IF (ASSOCIATED(potential%cval)) THEN
450 DEALLOCATE (potential%cval)
451 END IF
452
453 DEALLOCATE (potential)
454
455 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 SUBROUTINE deallocate_gth_potential(potential)
465 TYPE(gth_potential_type), POINTER :: potential
466
467 IF (.NOT. ASSOCIATED(potential)) THEN
468 cpabort("The pointer potential is not associated.")
469 END IF
470
471 DEALLOCATE (potential%elec_conf)
472 ! Deallocate the parameters of the local part
473
474 IF (ASSOCIATED(potential%cexp_ppl)) THEN
475 DEALLOCATE (potential%cexp_ppl)
476 END IF
477
478 ! Deallocate the parameters of the non-local part
479 IF (ASSOCIATED(potential%alpha_ppnl)) THEN
480 DEALLOCATE (potential%alpha_ppnl)
481 DEALLOCATE (potential%cprj)
482 DEALLOCATE (potential%cprj_ppnl)
483 DEALLOCATE (potential%hprj_ppnl)
484 DEALLOCATE (potential%kprj_ppnl)
485 DEALLOCATE (potential%nprj_ppnl)
486 DEALLOCATE (potential%vprj_ppnl)
487 DEALLOCATE (potential%wprj_ppnl)
488 END IF
489
490 IF (ASSOCIATED(potential%alpha_lpot)) THEN
491 DEALLOCATE (potential%alpha_lpot)
492 DEALLOCATE (potential%nct_lpot)
493 DEALLOCATE (potential%cval_lpot)
494 END IF
495
496 IF (ASSOCIATED(potential%alpha_lsd)) THEN
497 DEALLOCATE (potential%alpha_lsd)
498 DEALLOCATE (potential%nct_lsd)
499 DEALLOCATE (potential%cval_lsd)
500 END IF
501
502 IF (ASSOCIATED(potential%alpha_nlcc)) THEN
503 DEALLOCATE (potential%alpha_nlcc)
504 DEALLOCATE (potential%nct_nlcc)
505 DEALLOCATE (potential%cval_nlcc)
506 END IF
507
508 DEALLOCATE (potential)
509
510 END SUBROUTINE deallocate_gth_potential
511
512! **************************************************************************************************
513!> \brief Deallocate an atomic SGP potential data set.
514!> \param potential ...
515! **************************************************************************************************
516 SUBROUTINE deallocate_sgp_potential(potential)
517 TYPE(sgp_potential_type), POINTER :: potential
518
519 IF (.NOT. ASSOCIATED(potential)) THEN
520 cpabort("The pointer potential is not associated.")
521 END IF
522
523 IF (ASSOCIATED(potential%elec_conf)) THEN
524 DEALLOCATE (potential%elec_conf)
525 END IF
526 IF (ASSOCIATED(potential%a_local)) THEN
527 DEALLOCATE (potential%a_local)
528 END IF
529 IF (ASSOCIATED(potential%c_local)) THEN
530 DEALLOCATE (potential%c_local)
531 END IF
532
533 IF (ASSOCIATED(potential%a_nonlocal)) THEN
534 DEALLOCATE (potential%a_nonlocal)
535 END IF
536 IF (ASSOCIATED(potential%h_nonlocal)) THEN
537 DEALLOCATE (potential%h_nonlocal)
538 END IF
539 IF (ASSOCIATED(potential%c_nonlocal)) THEN
540 DEALLOCATE (potential%c_nonlocal)
541 END IF
542 IF (ASSOCIATED(potential%cprj_ppnl)) THEN
543 DEALLOCATE (potential%cprj_ppnl)
544 END IF
545 IF (ASSOCIATED(potential%vprj_ppnl)) THEN
546 DEALLOCATE (potential%vprj_ppnl)
547 END IF
548
549 IF (ASSOCIATED(potential%a_nlcc)) THEN
550 DEALLOCATE (potential%a_nlcc)
551 END IF
552 IF (ASSOCIATED(potential%c_nlcc)) THEN
553 DEALLOCATE (potential%c_nlcc)
554 END IF
555
556 DEALLOCATE (potential)
557
558 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 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 IF (PRESENT(name)) name = potential%name
588 IF (PRESENT(alpha_core_charge)) &
589 alpha_core_charge = potential%alpha_core_charge
590 IF (PRESENT(ccore_charge)) ccore_charge = potential%ccore_charge
591 IF (PRESENT(core_charge_radius)) &
592 core_charge_radius = potential%core_charge_radius
593 IF (PRESENT(z)) z = potential%z
594 IF (PRESENT(zeff)) zeff = potential%zeff
595 IF (PRESENT(zeff_correction)) zeff_correction = potential%zeff_correction
596 IF (PRESENT(elec_conf)) elec_conf => potential%elec_conf
597
598 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 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 IF (PRESENT(name)) name = potential%name
623 IF (PRESENT(apol)) apol = potential%apol
624 IF (PRESENT(cpol)) cpol = potential%cpol
625 IF (PRESENT(mm_radius)) mm_radius = potential%mm_radius
626 IF (PRESENT(qeff)) qeff = potential%qeff
627 IF (PRESENT(qmmm_corr_radius)) qmmm_corr_radius = potential%qmmm_corr_radius
628 IF (PRESENT(qmmm_radius)) qmmm_radius = potential%qmmm_radius
629
630 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 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 IF (PRESENT(name)) name = potential%name
655 IF (PRESENT(ngau)) ngau = potential%ngau
656 IF (PRESENT(npol)) npol = potential%npol
657 IF (PRESENT(alpha)) alpha => potential%alpha
658 IF (PRESENT(cval)) cval => potential%cval
659 IF (PRESENT(radius)) radius = potential%radius
660
661 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 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 IF (PRESENT(name)) name = potential%name
759 IF (PRESENT(aliases)) aliases = potential%aliases
760 IF (PRESENT(alpha_core_charge)) &
761 alpha_core_charge = potential%alpha_core_charge
762 IF (PRESENT(alpha_ppl)) alpha_ppl = potential%alpha_ppl
763 IF (PRESENT(ccore_charge)) ccore_charge = potential%ccore_charge
764 IF (PRESENT(cerf_ppl)) cerf_ppl = potential%cerf_ppl
765 IF (PRESENT(core_charge_radius)) &
766 core_charge_radius = potential%core_charge_radius
767 IF (PRESENT(ppl_radius)) ppl_radius = potential%ppl_radius
768 IF (PRESENT(ppnl_radius)) ppnl_radius = potential%ppnl_radius
769 IF (PRESENT(lppnl)) lppnl = potential%lppnl
770 IF (PRESENT(lprj_ppnl_max)) lprj_ppnl_max = potential%lprj_ppnl_max
771 IF (PRESENT(nexp_ppl)) nexp_ppl = potential%nexp_ppl
772 IF (PRESENT(nppnl)) nppnl = potential%nppnl
773 IF (PRESENT(nprj_ppnl_max)) nprj_ppnl_max = potential%nprj_ppnl_max
774 IF (PRESENT(z)) z = potential%z
775 IF (PRESENT(zeff)) zeff = potential%zeff
776 IF (PRESENT(zeff_correction)) zeff_correction = potential%zeff_correction
777 IF (PRESENT(ppl_present)) ppl_present = (potential%nexp_ppl > 0)
778 IF (PRESENT(ppnl_present)) ppnl_present = (potential%nppnl > 0)
779 IF (PRESENT(alpha_ppnl)) alpha_ppnl => potential%alpha_ppnl
780 IF (PRESENT(cexp_ppl)) cexp_ppl => potential%cexp_ppl
781 IF (PRESENT(elec_conf)) elec_conf => potential%elec_conf
782 IF (PRESENT(nprj_ppnl)) nprj_ppnl => potential%nprj_ppnl
783 IF (PRESENT(cprj)) cprj => potential%cprj
784 IF (PRESENT(cprj_ppnl)) cprj_ppnl => potential%cprj_ppnl
785 IF (PRESENT(hprj_ppnl)) hprj_ppnl => potential%hprj_ppnl
786 IF (PRESENT(kprj_ppnl)) kprj_ppnl => potential%kprj_ppnl
787 IF (PRESENT(vprj_ppnl)) vprj_ppnl => potential%vprj_ppnl
788 IF (PRESENT(wprj_ppnl)) wprj_ppnl => potential%wprj_ppnl
789
790 IF (PRESENT(lpot_present)) lpot_present = potential%lpotextended
791 IF (PRESENT(nexp_lpot)) nexp_lpot = potential%nexp_lpot
792 IF (PRESENT(alpha_lpot)) alpha_lpot => potential%alpha_lpot
793 IF (PRESENT(nct_lpot)) nct_lpot => potential%nct_lpot
794 IF (PRESENT(cval_lpot)) cval_lpot => potential%cval_lpot
795
796 IF (PRESENT(lsd_present)) lsd_present = potential%lsdpot
797 IF (PRESENT(nexp_lsd)) nexp_lsd = potential%nexp_lsd
798 IF (PRESENT(alpha_lsd)) alpha_lsd => potential%alpha_lsd
799 IF (PRESENT(nct_lsd)) nct_lsd => potential%nct_lsd
800 IF (PRESENT(cval_lsd)) cval_lsd => potential%cval_lsd
801
802 IF (PRESENT(nlcc_present)) nlcc_present = potential%nlcc
803 IF (PRESENT(nexp_nlcc)) nexp_nlcc = potential%nexp_nlcc
804 IF (PRESENT(alpha_nlcc)) alpha_nlcc => potential%alpha_nlcc
805 IF (PRESENT(nct_nlcc)) nct_nlcc => potential%nct_nlcc
806 IF (PRESENT(cval_nlcc)) cval_nlcc => potential%cval_nlcc
807
808 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 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 IF (PRESENT(name)) name = potential%name
904 IF (PRESENT(aliases)) aliases = potential%aliases
905 IF (PRESENT(description)) description = potential%description
906
907 IF (PRESENT(elec_conf)) elec_conf => potential%elec_conf
908
909 IF (PRESENT(z)) z = potential%z
910 IF (PRESENT(zeff)) zeff = potential%zeff
911 IF (PRESENT(zeff_correction)) zeff_correction = potential%zeff_correction
912 IF (PRESENT(alpha_core_charge)) alpha_core_charge = potential%alpha_core_charge
913 IF (PRESENT(ccore_charge)) ccore_charge = potential%ccore_charge
914 IF (PRESENT(core_charge_radius)) core_charge_radius = potential%core_charge_radius
915
916 IF (PRESENT(ppl_radius)) ppl_radius = potential%ppl_radius
917 IF (PRESENT(ppnl_radius)) ppnl_radius = potential%ppnl_radius
918 IF (PRESENT(ppl_present)) THEN
919 ppl_present = (potential%nloc > 0 .OR. potential%n_local > 0)
920 END IF
921 IF (PRESENT(ppnl_present)) THEN
922 ppnl_present = any(potential%is_nonlocal)
923 END IF
924 IF (PRESENT(ppsl_present)) THEN
925 ppsl_present = potential%ecp_semi_local
926 END IF
927
928 IF (PRESENT(ecp_local)) ecp_local = potential%ecp_local
929 IF (PRESENT(n_local)) n_local = potential%n_local
930 IF (PRESENT(a_local)) a_local => potential%a_local
931 IF (PRESENT(c_local)) c_local => potential%c_local
932
933 IF (PRESENT(nloc)) nloc = potential%nloc
934 IF (PRESENT(nrloc)) nrloc = potential%nrloc
935 IF (PRESENT(aloc)) aloc = potential%aloc
936 IF (PRESENT(bloc)) bloc = potential%bloc
937
938 IF (PRESENT(ecp_semi_local)) ecp_semi_local = potential%ecp_semi_local
939 IF (PRESENT(sl_lmax)) sl_lmax = potential%sl_lmax
940 IF (PRESENT(npot)) npot = potential%npot
941 IF (PRESENT(nrpot)) nrpot = potential%nrpot
942 IF (PRESENT(apot)) apot = potential%apot
943 IF (PRESENT(bpot)) bpot = potential%bpot
944
945 IF (PRESENT(n_nonlocal)) n_nonlocal = potential%n_nonlocal
946 IF (PRESENT(nppnl)) nppnl = potential%nppnl
947 IF (PRESENT(lmax)) lmax = potential%lmax
948 IF (PRESENT(is_nonlocal)) is_nonlocal(:) = potential%is_nonlocal(:)
949 IF (PRESENT(a_nonlocal)) a_nonlocal => potential%a_nonlocal
950 IF (PRESENT(c_nonlocal)) c_nonlocal => potential%c_nonlocal
951 IF (PRESENT(h_nonlocal)) h_nonlocal => potential%h_nonlocal
952 IF (PRESENT(cprj_ppnl)) cprj_ppnl => potential%cprj_ppnl
953 IF (PRESENT(vprj_ppnl)) vprj_ppnl => potential%vprj_ppnl
954
955 IF (PRESENT(has_nlcc)) has_nlcc = potential%has_nlcc
956 IF (PRESENT(n_nlcc)) n_nlcc = potential%n_nlcc
957 IF (PRESENT(a_nlcc)) a_nlcc => potential%a_nlcc
958 IF (PRESENT(c_nlcc)) c_nlcc => potential%c_nlcc
959
960 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 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 nprj = 0
982
983 DO l = 0, potential%lppnl
984 alpha_ppnl = potential%alpha_ppnl(l)
985 DO iprj_ppnl = 1, potential%nprj_ppnl(l)
986 lp = iprj_ppnl - 1
987 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 (rootpi*dfac(2*lprj_ppnl + 1)))
991 potential%cprj_ppnl(iprj_ppnl, l) = cp
992 DO cx = 0, l
993 DO cy = 0, l - cx
994 cz = l - cx - cy
995 iprj = nprj + co(cx, cy, cz)
996 DO px = 0, lp
997 DO py = 0, lp - px
998 pz = lp - px - py
999 cpx = cx + 2*px
1000 cpy = cy + 2*py
1001 cpz = cz + 2*pz
1002 ico = coset(cpx, cpy, cpz)
1003 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 nprj = nprj + nco(l)
1009 END DO
1010 END DO
1011
1012 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 SUBROUTINE init_gth_potential(potential)
1022
1023 TYPE(gth_potential_type), INTENT(IN), POINTER :: potential
1024
1025 IF (.NOT. ASSOCIATED(potential)) RETURN
1026
1027 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 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 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 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 nprj = 0
1057
1058 DO l = 0, potential%lppnl
1059 DO iprj_ppnl = 1, potential%nprj_ppnl(l)
1060 iprj = nprj + (iprj_ppnl - 1)*nco(l)
1061 DO jprj_ppnl = 1, potential%nprj_ppnl(l)
1062 jprj = nprj + (jprj_ppnl - 1)*nco(l)
1063 DO ico = 1, nco(l)
1064 i = iprj + ico
1065 DO jco = 1, nco(l)
1066 j = jprj + jco
1067 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 orbtramat(l)%slm(iso, jco)
1073 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 orbtramat(l)%slm(iso, jco)
1080 END IF
1081 END DO
1082 END DO
1083 END DO
1084 END DO
1085 END DO
1086 nprj = nprj + potential%nprj_ppnl(l)*nco(l)
1087 END DO
1088
1089 END SUBROUTINE init_vprj_ppnl
1090
1091! **************************************************************************************************
1092!> \brief ...
1093!> \param potential ...
1094!> \param itype ...
1095!> \param zeff ...
1096!> \param zeff_correction ...
1097! **************************************************************************************************
1098 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 IF (.NOT. ASSOCIATED(potential)) RETURN
1107
1108 IF (PRESENT(zeff)) potential%zeff = zeff
1109 IF (PRESENT(zeff_correction)) potential%zeff_correction = zeff_correction
1110 dz = potential%z - int(potential%zeff - potential%zeff_correction)
1111 SELECT CASE (dz)
1112 CASE DEFAULT
1113 CASE (2)
1114 potential%elec_conf(0) = potential%elec_conf(0) - 2
1115 CASE (10)
1116 potential%elec_conf(0) = potential%elec_conf(0) - 4
1117 potential%elec_conf(1) = potential%elec_conf(1) - 6
1118 CASE (18)
1119 potential%elec_conf(0) = potential%elec_conf(0) - 6
1120 potential%elec_conf(1) = potential%elec_conf(1) - 12
1121 CASE (28)
1122 potential%elec_conf(0) = potential%elec_conf(0) - 6
1123 potential%elec_conf(1) = potential%elec_conf(1) - 12
1124 potential%elec_conf(2) = potential%elec_conf(2) - 10
1125 CASE (30)
1126 potential%elec_conf(0) = potential%elec_conf(0) - 8
1127 potential%elec_conf(1) = potential%elec_conf(1) - 12
1128 potential%elec_conf(2) = potential%elec_conf(2) - 10
1129 CASE (36)
1130 potential%elec_conf(0) = potential%elec_conf(0) - 8
1131 potential%elec_conf(1) = potential%elec_conf(1) - 18
1132 potential%elec_conf(2) = potential%elec_conf(2) - 10
1133 CASE (46)
1134 potential%elec_conf(0) = potential%elec_conf(0) - 8
1135 potential%elec_conf(1) = potential%elec_conf(1) - 18
1136 potential%elec_conf(2) = potential%elec_conf(2) - 20
1137 CASE (48)
1138 potential%elec_conf(0) = potential%elec_conf(0) - 10
1139 potential%elec_conf(1) = potential%elec_conf(1) - 18
1140 potential%elec_conf(2) = potential%elec_conf(2) - 20
1141 CASE (54)
1142 potential%elec_conf(0) = potential%elec_conf(0) - 10
1143 potential%elec_conf(1) = potential%elec_conf(1) - 24
1144 potential%elec_conf(2) = potential%elec_conf(2) - 20
1145 CASE (68)
1146 potential%elec_conf(0) = potential%elec_conf(0) - 10
1147 potential%elec_conf(1) = potential%elec_conf(1) - 24
1148 potential%elec_conf(2) = potential%elec_conf(2) - 20
1149 potential%elec_conf(3) = potential%elec_conf(3) - 14
1150 CASE (78)
1151 potential%elec_conf(0) = potential%elec_conf(0) - 10
1152 potential%elec_conf(1) = potential%elec_conf(1) - 24
1153 potential%elec_conf(2) = potential%elec_conf(2) - 30
1154 potential%elec_conf(3) = potential%elec_conf(3) - 14
1155 CASE (80)
1156 potential%elec_conf(0) = potential%elec_conf(0) - 12
1157 potential%elec_conf(1) = potential%elec_conf(1) - 24
1158 potential%elec_conf(2) = potential%elec_conf(2) - 30
1159 potential%elec_conf(3) = potential%elec_conf(3) - 14
1160 CASE (86)
1161 potential%elec_conf(0) = potential%elec_conf(0) - 12
1162 potential%elec_conf(1) = potential%elec_conf(1) - 30
1163 potential%elec_conf(2) = potential%elec_conf(2) - 30
1164 potential%elec_conf(3) = potential%elec_conf(3) - 14
1165 CASE (100)
1166 potential%elec_conf(0) = potential%elec_conf(0) - 12
1167 potential%elec_conf(1) = potential%elec_conf(1) - 30
1168 potential%elec_conf(2) = potential%elec_conf(2) - 30
1169 potential%elec_conf(3) = potential%elec_conf(3) - 28
1170 END SELECT
1171
1172 IF (PRESENT(itype)) THEN
1173 IF (itype == "BARE") THEN
1174 potential%description(1) = "Bare Coulomb Potential"
1175 IF (dz > 0) THEN
1176 potential%description(2) = "Valence charge only"
1177 ELSE
1178 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 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 INTEGER, ALLOCATABLE, DIMENSION(:, :) :: ind1, ind2
1195 REAL(KIND=dp), DIMENSION(:, :), POINTER :: cprj, hnl
1196 REAL(KIND=dp), DIMENSION(:, :, :), POINTER :: cn
1197
1198 IF (ASSOCIATED(potential)) THEN
1199 IF (potential%nppnl > 0) THEN
1200 !
1201 IF (ASSOCIATED(potential%cprj_ppnl)) THEN
1202 DEALLOCATE (potential%cprj_ppnl)
1203 END IF
1204 nnl = potential%n_nonlocal
1205 nprj = 0
1206 DO l = 0, potential%lmax
1207 nprj = nprj + nnl*nso(l)
1208 END DO
1209 ALLOCATE (potential%cprj_ppnl(potential%nppnl, nprj))
1210 cprj => potential%cprj_ppnl
1211 cprj = 0.0_dp
1212 cn => potential%c_nonlocal
1213 !
1214 ALLOCATE (ind1(potential%nppnl, 3))
1215 n1 = 0
1216 DO i1 = 1, nnl
1217 DO la = 0, potential%lmax
1218 DO j1 = 1, nco(la)
1219 n1 = n1 + 1
1220 ind1(n1, 1) = la
1221 ind1(n1, 2) = j1
1222 ind1(n1, 3) = i1
1223 END DO
1224 END DO
1225 END DO
1226 !
1227 ALLOCATE (ind2(nprj, 3))
1228 n2 = 0
1229 DO i2 = 1, nnl
1230 DO lb = 0, potential%lmax
1231 DO j2 = 1, nso(lb)
1232 n2 = n2 + 1
1233 ind2(n2, 1) = lb
1234 ind2(n2, 2) = j2
1235 ind2(n2, 3) = i2
1236 END DO
1237 END DO
1238 END DO
1239 !
1240 DO n1 = 1, SIZE(ind1, 1)
1241 la = ind1(n1, 1)
1242 j1 = ind1(n1, 2)
1243 i1 = ind1(n1, 3)
1244 DO n2 = 1, SIZE(ind2, 1)
1245 lb = ind2(n2, 1)
1246 IF (la /= lb) cycle
1247 j2 = ind2(n2, 2)
1248 i2 = ind2(n2, 3)
1249 cprj(n1, n2) = orbtramat(la)%c2s(j2, j1)*cn(i1, i2, la)
1250 END DO
1251 END DO
1252 !
1253 hnl => potential%h_nonlocal
1254 IF (ASSOCIATED(potential%vprj_ppnl)) THEN
1255 DEALLOCATE (potential%vprj_ppnl)
1256 END IF
1257 ALLOCATE (potential%vprj_ppnl(nprj))
1258 potential%vprj_ppnl = 0.0_dp
1259 DO n2 = 1, SIZE(ind2, 1)
1260 lb = ind2(n2, 1)
1261 i2 = ind2(n2, 3)
1262 potential%vprj_ppnl(n2) = hnl(i2, lb)
1263 END DO
1264 !
1265 DEALLOCATE (ind1, ind2)
1266 END IF
1267 END IF
1268
1269 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 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 CHARACTER(LEN=LEN(element_symbol)) :: symbol
1300 CHARACTER(LEN=LEN(element_symbol)+2) :: symbol2
1301 CHARACTER(LEN=LEN(potential_name)) :: apname
1302 CHARACTER(LEN=LEN(potential_name)+2) :: apname2
1303 INTEGER :: irep, l, strlen1, strlen2
1304 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 line2 = ""
1312 symbol2 = ""
1313 apname2 = ""
1314 NULLIFY (parser)
1315 CALL cite_reference(krack2000)
1316
1317 potential%name = potential_name
1318 read_from_input = .false.
1319 CALL section_vals_get(potential_section, explicit=read_from_input)
1320 IF (.NOT. read_from_input) THEN
1321 ALLOCATE (parser)
1322 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 apname = potential_name
1329 symbol = element_symbol
1330 irep = 0
1331 search_loop: DO
1332 IF (read_from_input) THEN
1333 NULLIFY (list, val)
1334 found = .true.
1335 CALL section_vals_list_get(potential_section, "_DEFAULT_KEYWORD_", list=list)
1336 ELSE
1337 CALL parser_search_string(parser, trim(apname), .true., found, line)
1338 END IF
1339 IF (found) THEN
1340 CALL uppercase(symbol)
1341 CALL uppercase(apname)
1342
1343 IF (read_from_input) THEN
1344 match = .true.
1345 ELSE
1346 ! Check both the element symbol and the atomic potential name
1347 match = .false.
1348 CALL uppercase(line)
1349 line2 = " "//line//" "
1350 symbol2 = " "//trim(symbol)//" "
1351 apname2 = " "//trim(apname)//" "
1352 strlen1 = len_trim(symbol2) + 1
1353 strlen2 = len_trim(apname2) + 1
1354
1355 IF ((index(line2, symbol2(:strlen1)) > 0) .AND. &
1356 (index(line2, apname2(:strlen2)) > 0)) match = .true.
1357 END IF
1358 IF (match) THEN
1359 ! Read the electronic configuration
1360 NULLIFY (elec_conf)
1361 l = 0
1362 CALL reallocate(elec_conf, 0, l)
1363 IF (read_from_input) THEN
1364 is_ok = cp_sll_val_next(list, val)
1365 IF (.NOT. is_ok) &
1366 CALL cp_abort(__location__, &
1367 "Error reading the Potential from input file!")
1368 CALL val_get(val, c_val=line_att)
1369 READ (line_att, *) elec_conf(l)
1370 CALL remove_word(line_att)
1371 DO WHILE (len_trim(line_att) /= 0)
1372 l = l + 1
1373 CALL reallocate(elec_conf, 0, l)
1374 READ (line_att, *) elec_conf(l)
1375 CALL remove_word(line_att)
1376 END DO
1377 ELSE
1378 CALL parser_get_object(parser, elec_conf(l), newline=.true.)
1379 DO WHILE (parser_test_next_token(parser) == "INT")
1380 l = l + 1
1381 CALL reallocate(elec_conf, 0, l)
1382 CALL parser_get_object(parser, elec_conf(l))
1383 END DO
1384 irep = irep + 1
1385 IF (update_input) THEN
1386 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 c_val=trim(line_att))
1389 END IF
1390 END IF
1391
1392 CALL reallocate(potential%elec_conf, 0, l)
1393 potential%elec_conf(:) = elec_conf(:)
1394
1395 potential%zeff_correction = zeff_correction
1396 potential%zeff = real(sum(elec_conf), dp) + zeff_correction
1397
1398 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 IF (read_from_input) THEN
1404 is_ok = cp_sll_val_next(list, val)
1405 IF (.NOT. is_ok) &
1406 CALL cp_abort(__location__, &
1407 "Error reading the Potential from input file!")
1408 CALL val_get(val, c_val=line_att)
1409 READ (line_att, *) r
1410 ELSE
1411 CALL parser_get_object(parser, r, newline=.true.)
1412 irep = irep + 1
1413 IF (update_input) THEN
1414 WRITE (unit=line_att, fmt="(T9,ES25.16E3)") r
1415 CALL section_vals_val_set(potential_section, "_DEFAULT_KEYWORD_", i_rep_val=irep, &
1416 c_val=trim(line_att))
1417 END IF
1418 END IF
1419 alpha = 1.0_dp/(2.0_dp*r**2)
1420
1421 potential%alpha_core_charge = alpha
1422 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 trim(potential_file_name)//">")
1435 END IF
1436 END DO search_loop
1437
1438 IF (.NOT. read_from_input) THEN
1439 ! Dump the potential info in the potential section
1440 IF (match .AND. update_input) THEN
1441 irep = irep + 1
1442 WRITE (unit=line_att, fmt="(T9,A)") &
1443 "# Potential name: "//trim(adjustl(apname2(:strlen2)))// &
1444 " for element symbol: "//trim(adjustl(symbol2(:strlen1)))
1445 CALL section_vals_val_set(potential_section, "_DEFAULT_KEYWORD_", i_rep_val=irep, &
1446 c_val=trim(line_att))
1447 irep = irep + 1
1448 WRITE (unit=line_att, fmt="(T9,A)") &
1449 "# 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 c_val=trim(line_att))
1452 END IF
1453 CALL parser_release(parser)
1454 DEALLOCATE (parser)
1455 END IF
1456
1457 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 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 CHARACTER(LEN=LEN(element_symbol)) :: symbol
1488 CHARACTER(LEN=LEN(element_symbol)+2) :: symbol2
1489 CHARACTER(LEN=LEN(potential_name)) :: apname
1490 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 REAL(KIND=dp), DIMENSION(:), POINTER :: alpha
1495 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 line2 = ""
1501 symbol2 = ""
1502 apname2 = ""
1503 NULLIFY (parser, alpha, cval)
1504
1505 potential%name = potential_name
1506 read_from_input = .false.
1507 CALL section_vals_get(potential_section, explicit=read_from_input)
1508 IF (.NOT. read_from_input) THEN
1509 ALLOCATE (parser)
1510 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 apname = potential_name
1517 symbol = element_symbol
1518 irep = 0
1519 search_loop: DO
1520 IF (read_from_input) THEN
1521 NULLIFY (list, val)
1522 found = .true.
1523 CALL section_vals_list_get(potential_section, "_DEFAULT_KEYWORD_", list=list)
1524 ELSE
1525 CALL parser_search_string(parser, trim(apname), .true., found, line)
1526 END IF
1527 IF (found) THEN
1528 CALL uppercase(symbol)
1529 CALL uppercase(apname)
1530
1531 IF (read_from_input) THEN
1532 match = .true.
1533 ELSE
1534 ! Check both the element symbol and the atomic potential name
1535 match = .false.
1536 CALL uppercase(line)
1537 line2 = " "//line//" "
1538 symbol2 = " "//trim(symbol)//" "
1539 apname2 = " "//trim(apname)//" "
1540 strlen1 = len_trim(symbol2) + 1
1541 strlen2 = len_trim(apname2) + 1
1542
1543 IF ((index(line2, symbol2(:strlen1)) > 0) .AND. &
1544 (index(line2, apname2(:strlen2)) > 0)) match = .true.
1545 END IF
1546 IF (match) THEN
1547
1548 ! Read ngau and npol
1549 IF (read_from_input) THEN
1550 is_ok = cp_sll_val_next(list, val)
1551 IF (.NOT. is_ok) &
1552 CALL cp_abort(__location__, &
1553 "Error reading the Potential from input file!")
1554 CALL val_get(val, c_val=line_att)
1555 READ (line_att, *) ngau, npol
1556 CALL remove_word(line_att)
1557 ELSE
1558 CALL parser_get_object(parser, ngau, newline=.true.)
1559 CALL parser_get_object(parser, npol)
1560 irep = irep + 1
1561 IF (update_input) THEN
1562 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 c_val=trim(line_att))
1565 END IF
1566 END IF
1567
1568 CALL reallocate(alpha, 1, ngau)
1569 CALL reallocate(cval, 1, ngau, 1, npol)
1570 DO igau = 1, ngau
1571 IF (read_from_input) THEN
1572 is_ok = cp_sll_val_next(list, val)
1573 IF (.NOT. is_ok) &
1574 CALL cp_abort(__location__, &
1575 "Error reading the Potential from input file!")
1576 CALL val_get(val, c_val=line_att)
1577 READ (line_att, *) alpha(igau), (cval(igau, ipol), ipol=1, npol)
1578 ELSE
1579 CALL parser_get_object(parser, alpha(igau), newline=.true.)
1580 DO ipol = 1, npol
1581 CALL parser_get_object(parser, cval(igau, ipol), newline=.false.)
1582 END DO
1583 irep = irep + 1
1584 IF (update_input) THEN
1585 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 c_val=trim(line_att))
1588 END IF
1589 END IF
1590 END DO
1591 alpha = 1.0_dp/(2.0_dp*alpha**2)
1592
1593 potential%ngau = ngau
1594 potential%npol = npol
1595
1596 potential%alpha => alpha
1597 potential%cval => cval
1598
1599 potential%radius = 0.0_dp
1600 DO igau = 1, ngau
1601 DO ipol = 1, npol
1602 l = 2*(ipol - 1)
1603 potential%radius = max(potential%radius, &
1604 exp_radius(l, alpha(igau), eps_tpot, cval(igau, ipol), &
1605 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 trim(potential_file_name)//">")
1620 END IF
1621 END DO search_loop
1622
1623 IF (.NOT. read_from_input) THEN
1624 ! Dump the potential info in the potential section
1625 IF (match .AND. update_input) THEN
1626 irep = irep + 1
1627 WRITE (unit=line_att, fmt="(A)") &
1628 "# Potential name: "//trim(adjustl(apname2(:strlen2)))// &
1629 " for element symbol: "//trim(adjustl(symbol2(:strlen1)))
1630 CALL section_vals_val_set(potential_section, "_DEFAULT_KEYWORD_", i_rep_val=irep, &
1631 c_val=trim(line_att))
1632 irep = irep + 1
1633 WRITE (unit=line_att, fmt="(A)") &
1634 "# 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 c_val=trim(line_att))
1637 END IF
1638 CALL parser_release(parser)
1639 DEALLOCATE (parser)
1640 END IF
1641
1642 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 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 CHARACTER(LEN=LEN(element_symbol)) :: symbol
1680 CHARACTER(LEN=LEN(element_symbol)+2) :: symbol2
1681 CHARACTER(LEN=LEN(potential_name)) :: apname
1682 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 INTEGER, DIMENSION(:), POINTER :: elec_conf
1688 LOGICAL :: found, is_ok, match, read_from_input
1689 REAL(KIND=dp) :: alpha, ci, r, rc2
1690 REAL(KIND=dp), DIMENSION(:), POINTER :: tmp_vals
1691 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 line2 = ""
1697 symbol2 = ""
1698 apname2 = ""
1699 NULLIFY (parser, tmp_vals)
1700 CALL cite_reference(goedecker1996)
1701 CALL cite_reference(hartwigsen1998)
1702 CALL cite_reference(krack2005)
1703
1704 potential%name = potential_name
1705 potential%aliases = potential_name
1706 read_from_input = .false.
1707 CALL section_vals_get(potential_section, explicit=read_from_input)
1708 IF (.NOT. read_from_input) THEN
1709 ALLOCATE (parser)
1710 CALL parser_create(parser, potential_file_name, para_env=para_env)
1711 END IF
1712
1713 ! Initialize extended form
1714 potential%lpotextended = .false.
1715 potential%nexp_lpot = 0
1716 potential%lsdpot = .false.
1717 potential%nexp_lsd = 0
1718 potential%nlcc = .false.
1719 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 apname = potential_name
1724 symbol = element_symbol
1725 irep = 0
1726 search_loop: DO
1727 IF (read_from_input) THEN
1728 NULLIFY (list, val)
1729 found = .true.
1730 CALL section_vals_list_get(potential_section, "_DEFAULT_KEYWORD_", list=list)
1731 ELSE
1732 CALL parser_search_string(parser, trim(apname), .true., found, line)
1733 END IF
1734 IF (found) THEN
1735 CALL uppercase(symbol)
1736 CALL uppercase(apname)
1737 IF (read_from_input) THEN
1738 match = .true.
1739 ELSE
1740 ! Check both the element symbol and the atomic potential name
1741 match = .false.
1742 CALL uppercase(line)
1743 line2 = " "//line//" "
1744 symbol2 = " "//trim(symbol)//" "
1745 apname2 = " "//trim(apname)//" "
1746 strlen1 = len_trim(symbol2) + 1
1747 strlen2 = len_trim(apname2) + 1
1748 i = index(line2, symbol2(:strlen1))
1749 j = index(line2, apname2(:strlen2))
1750 IF (i > 0 .AND. j > 0) THEN
1751 match = .true.
1752 i = i + 1 + index(line2(i + 1:), " ")
1753 potential%aliases = line2(i:) ! copy all names into aliases field
1754 END IF
1755 END IF
1756 IF (match) THEN
1757 ! Read the electronic configuration
1758 NULLIFY (elec_conf)
1759 l = 0
1760 CALL reallocate(elec_conf, 0, l)
1761 IF (read_from_input) THEN
1762 is_ok = cp_sll_val_next(list, val)
1763 IF (.NOT. is_ok) &
1764 CALL cp_abort(__location__, &
1765 "Error while reading GTH potential from input file")
1766 CALL val_get(val, c_val=line_att)
1767 READ (line_att, *) elec_conf(l)
1768 CALL remove_word(line_att)
1769 DO WHILE (len_trim(line_att) /= 0)
1770 l = l + 1
1771 CALL reallocate(elec_conf, 0, l)
1772 READ (line_att, *) elec_conf(l)
1773 CALL remove_word(line_att)
1774 END DO
1775 ELSE
1776 CALL parser_get_object(parser, elec_conf(l), newline=.true.)
1777 DO WHILE (parser_test_next_token(parser) == "INT")
1778 l = l + 1
1779 CALL reallocate(elec_conf, 0, l)
1780 CALL parser_get_object(parser, elec_conf(l))
1781 END DO
1782 irep = irep + 1
1783 IF (update_input) THEN
1784 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 c_val=trim(line_att))
1787 END IF
1788 END IF
1789
1790 CALL reallocate(potential%elec_conf, 0, l)
1791 potential%elec_conf(:) = elec_conf(:)
1792
1793 potential%zeff_correction = zeff_correction
1794 potential%zeff = real(sum(elec_conf), dp) + zeff_correction
1795
1796 DEALLOCATE (elec_conf)
1797
1798 ! Read r(loc) to define the exponent of the core charge
1799 ! distribution and calculate the corresponding coefficient
1800 IF (read_from_input) THEN
1801 is_ok = cp_sll_val_next(list, val)
1802 IF (.NOT. is_ok) &
1803 CALL cp_abort(__location__, &
1804 "Error while reading GTH potential from input file")
1805 CALL val_get(val, c_val=line_att)
1806 READ (line_att, *) r
1807 CALL remove_word(line_att)
1808 ELSE
1809 line_att = ""
1810 CALL parser_get_object(parser, r, newline=.true.)
1811 istr = len_trim(line_att) + 1
1812 WRITE (unit=line_att(istr:), fmt="(T9,ES25.16E3)") r
1813 END IF
1814 alpha = 1.0_dp/(2.0_dp*r**2)
1815
1816 potential%alpha_core_charge = alpha
1817 potential%ccore_charge = potential%zeff*sqrt((alpha/pi)**3)
1818
1819 potential%alpha_ppl = alpha
1820 potential%cerf_ppl = potential%zeff*sqrt((alpha/pi)**3)
1821
1822 ! Read the parameters for the local part of the GTH pseudopotential (ppl)
1823 IF (read_from_input) THEN
1824 READ (line_att, *) n
1825 CALL remove_word(line_att)
1826 ELSE
1827 CALL parser_get_object(parser, n)
1828 istr = len_trim(line_att) + 1
1829 WRITE (unit=line_att(istr:), fmt="(1X,I0)") n
1830 END IF
1831 potential%nexp_ppl = n
1832 CALL reallocate(potential%cexp_ppl, 1, n)
1833
1834 DO i = 1, n
1835 IF (read_from_input) THEN
1836 READ (line_att, *) ci
1837 CALL remove_word(line_att)
1838 ELSE
1839 CALL parser_get_object(parser, ci)
1840 istr = len_trim(line_att) + 1
1841 WRITE (unit=line_att(istr:), fmt="(ES25.16E3)") ci
1842 END IF
1843 rc2 = (2.0_dp*potential%alpha_ppl)
1844 potential%cexp_ppl(i) = rc2**(i - 1)*ci
1845 END DO
1846
1847 IF (.NOT. read_from_input) THEN
1848 irep = irep + 1
1849 IF (update_input) THEN
1850 CALL section_vals_val_set(potential_section, "_DEFAULT_KEYWORD_", i_rep_val=irep, &
1851 c_val=trim(line_att))
1852 END IF
1853 line_att = ""
1854 ELSE
1855 IF (len_trim(line_att) /= 0) THEN
1856 CALL cp_abort(__location__, &
1857 "Error while reading GTH potential from input file")
1858 END IF
1859 END IF
1860 maxlppl = 2*(n - 1)
1861
1862 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 IF (read_from_input) THEN
1867 read_keywords_from_input: DO
1868 is_ok = cp_sll_val_next(list, val)
1869 cpassert(is_ok)
1870 CALL val_get(val, c_val=line_att)
1871 IF (index(line_att, "LPOT") /= 0) THEN
1872 potential%lpotextended = .true.
1873 CALL remove_word(line_att)
1874 READ (line_att, *) potential%nexp_lpot
1875 n = potential%nexp_lpot
1876 maxlppl = 2*(n - 1)
1877 IF (maxlppl > -1) CALL init_orbital_pointers(maxlppl)
1878 NULLIFY (potential%alpha_lpot, potential%nct_lpot, potential%cval_lpot)
1879 CALL reallocate(potential%alpha_lpot, 1, n)
1880 CALL reallocate(potential%nct_lpot, 1, n)
1881 CALL reallocate(potential%cval_lpot, 1, 4, 1, n)
1882 DO ipot = 1, potential%nexp_lpot
1883 is_ok = cp_sll_val_next(list, val)
1884 cpassert(is_ok)
1885 CALL val_get(val, c_val=line_att)
1886 READ (line_att, *) r
1887 potential%alpha_lpot(ipot) = 0.5_dp/(r*r)
1888 CALL remove_word(line_att)
1889 READ (line_att, *) potential%nct_lpot(ipot)
1890 CALL remove_word(line_att)
1891 DO ic = 1, potential%nct_lpot(ipot)
1892 READ (line_att, *) ci
1893 rc2 = (2._dp*potential%alpha_lpot(ipot))**(ic - 1)
1894 potential%cval_lpot(ic, ipot) = ci*rc2
1895 CALL remove_word(line_att)
1896 END DO
1897 END DO
1898 ELSE IF (index(line_att, "NLCC") /= 0) THEN
1899 potential%nlcc = .true.
1900 CALL remove_word(line_att)
1901 READ (line_att, *) potential%nexp_nlcc
1902 n = potential%nexp_nlcc
1903 NULLIFY (potential%alpha_nlcc, potential%nct_nlcc, potential%cval_nlcc)
1904 CALL reallocate(potential%alpha_nlcc, 1, n)
1905 CALL reallocate(potential%nct_nlcc, 1, n)
1906 CALL reallocate(potential%cval_nlcc, 1, 4, 1, n)
1907 DO ipot = 1, potential%nexp_nlcc
1908 is_ok = cp_sll_val_next(list, val)
1909 cpassert(is_ok)
1910 CALL val_get(val, c_val=line_att)
1911 READ (line_att, *) potential%alpha_nlcc(ipot)
1912 CALL remove_word(line_att)
1913 READ (line_att, *) potential%nct_nlcc(ipot)
1914 CALL remove_word(line_att)
1915 DO ic = 1, potential%nct_nlcc(ipot)
1916 READ (line_att, *) potential%cval_nlcc(ic, ipot)
1917 ! Make it compatible with BigDFT style
1918 potential%cval_nlcc(ic, ipot) = potential%cval_nlcc(ic, ipot)/(4.0_dp*pi)
1919 CALL remove_word(line_att)
1920 END DO
1921 END DO
1922 ELSE IF (index(line_att, "LSD") /= 0) THEN
1923 potential%lsdpot = .true.
1924 CALL remove_word(line_att)
1925 READ (line_att, *) potential%nexp_lsd
1926 n = potential%nexp_lsd
1927 NULLIFY (potential%alpha_lsd, potential%nct_lsd, potential%cval_lsd)
1928 CALL reallocate(potential%alpha_lsd, 1, n)
1929 CALL reallocate(potential%nct_lsd, 1, n)
1930 CALL reallocate(potential%cval_lsd, 1, 4, 1, n)
1931 DO ipot = 1, potential%nexp_lsd
1932 is_ok = cp_sll_val_next(list, val)
1933 cpassert(is_ok)
1934 CALL val_get(val, c_val=line_att)
1935 READ (line_att, *) r
1936 potential%alpha_lsd(ipot) = 0.5_dp/(r*r)
1937 CALL remove_word(line_att)
1938 READ (line_att, *) potential%nct_lsd(ipot)
1939 CALL remove_word(line_att)
1940 DO ic = 1, potential%nct_lsd(ipot)
1941 READ (line_att, *) ci
1942 rc2 = (2._dp*potential%alpha_lsd(ipot))**(ic - 1)
1943 potential%cval_lsd(ic, ipot) = ci*rc2
1944 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 CALL parser_get_next_line(parser, 1)
1954 IF (parser_test_next_token(parser) == "INT") THEN
1955 EXIT read_keywords
1956 ELSE IF (parser_test_next_token(parser) == "STR") THEN
1957 CALL parser_get_object(parser, line)
1958 IF (index(line, "LPOT") /= 0) THEN
1959 ! Local potential
1960 potential%lpotextended = .true.
1961 CALL parser_get_object(parser, potential%nexp_lpot)
1962 n = potential%nexp_lpot
1963 NULLIFY (potential%alpha_lpot, potential%nct_lpot, potential%cval_lpot)
1964 CALL reallocate(potential%alpha_lpot, 1, n)
1965 CALL reallocate(potential%nct_lpot, 1, n)
1966 CALL reallocate(potential%cval_lpot, 1, 4, 1, n)
1967 ! Add to input section
1968 irep = irep + 1
1969 IF (update_input) THEN
1970 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 c_val=trim(line_att))
1973 END IF
1974 DO ipot = 1, potential%nexp_lpot
1975 CALL parser_get_object(parser, r, newline=.true.)
1976 potential%alpha_lpot(ipot) = 0.5_dp/(r*r)
1977 CALL parser_get_object(parser, potential%nct_lpot(ipot))
1978 CALL reallocate(tmp_vals, 1, potential%nct_lpot(ipot))
1979 DO ic = 1, potential%nct_lpot(ipot)
1980 CALL parser_get_object(parser, ci)
1981 tmp_vals(ic) = ci
1982 rc2 = (2._dp*potential%alpha_lpot(ipot))**(ic - 1)
1983 potential%cval_lpot(ic, ipot) = ci*rc2
1984 END DO
1985 ! Add to input section
1986 irep = irep + 1
1987 IF (update_input) THEN
1988 WRITE (unit=line_att, fmt="(T9,ES25.16E3,1X,I0,*(ES25.16E3))") &
1989 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 c_val=trim(line_att))
1992 END IF
1993 END DO
1994 ELSE IF (index(line, "NLCC") /= 0) THEN
1995 ! NLCC
1996 potential%nlcc = .true.
1997 CALL parser_get_object(parser, potential%nexp_nlcc)
1998 n = potential%nexp_nlcc
1999 NULLIFY (potential%alpha_nlcc, potential%nct_nlcc, potential%cval_nlcc)
2000 CALL reallocate(potential%alpha_nlcc, 1, n)
2001 CALL reallocate(potential%nct_nlcc, 1, n)
2002 CALL reallocate(potential%cval_nlcc, 1, 4, 1, n)
2003 ! Add to input section
2004 WRITE (unit=line_att, fmt="(T9,A,1X,I0)") "NLCC", n
2005 irep = irep + 1
2006 CALL section_vals_val_set(potential_section, "_DEFAULT_KEYWORD_", i_rep_val=irep, &
2007 c_val=trim(line_att))
2008 DO ipot = 1, potential%nexp_nlcc
2009 CALL parser_get_object(parser, potential%alpha_nlcc(ipot), newline=.true.)
2010 CALL parser_get_object(parser, potential%nct_nlcc(ipot))
2011 CALL reallocate(tmp_vals, 1, potential%nct_nlcc(ipot))
2012 DO ic = 1, potential%nct_nlcc(ipot)
2013 CALL parser_get_object(parser, potential%cval_nlcc(ic, ipot))
2014 tmp_vals(ic) = potential%cval_nlcc(ic, ipot)
2015 ! Make it compatible with BigDFT style
2016 potential%cval_nlcc(ic, ipot) = potential%cval_nlcc(ic, ipot)/(4.0_dp*pi)
2017 END DO
2018 ! Add to input section
2019 irep = irep + 1
2020 IF (update_input) THEN
2021 WRITE (unit=line_att, fmt="(T9,ES25.16E3,1X,I0,*(ES25.16E3))") &
2022 potential%alpha_nlcc(ipot), potential%nct_nlcc(ipot), &
2023 tmp_vals(1:potential%nct_nlcc(ipot))
2024 CALL section_vals_val_set(potential_section, "_DEFAULT_KEYWORD_", i_rep_val=irep, &
2025 c_val=trim(line_att))
2026 END IF
2027 END DO
2028 ELSE IF (index(line, "LSD") /= 0) THEN
2029 ! LSD potential
2030 potential%lsdpot = .true.
2031 CALL parser_get_object(parser, potential%nexp_lsd)
2032 n = potential%nexp_lsd
2033 NULLIFY (potential%alpha_lsd, potential%nct_lsd, potential%cval_lsd)
2034 CALL reallocate(potential%alpha_lsd, 1, n)
2035 CALL reallocate(potential%nct_lsd, 1, n)
2036 CALL reallocate(potential%cval_lsd, 1, 4, 1, n)
2037 ! Add to input section
2038 irep = irep + 1
2039 IF (update_input) THEN
2040 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 c_val=trim(line_att))
2043 END IF
2044 DO ipot = 1, potential%nexp_lsd
2045 CALL parser_get_object(parser, r, newline=.true.)
2046 potential%alpha_lsd(ipot) = 0.5_dp/(r*r)
2047 CALL parser_get_object(parser, potential%nct_lsd(ipot))
2048 CALL reallocate(tmp_vals, 1, potential%nct_lsd(ipot))
2049 DO ic = 1, potential%nct_lsd(ipot)
2050 CALL parser_get_object(parser, ci)
2051 tmp_vals(ic) = ci
2052 rc2 = (2._dp*potential%alpha_lsd(ipot))**(ic - 1)
2053 potential%cval_lsd(ic, ipot) = ci*rc2
2054 END DO
2055 ! Add to input section
2056 irep = irep + 1
2057 IF (update_input) THEN
2058 WRITE (unit=line_att, fmt="(T9,ES25.16E3,1X,I0,*(ES25.16E3))") r, potential%nct_lsd(ipot), &
2059 tmp_vals(1:potential%nct_lsd(ipot))
2060 CALL section_vals_val_set(potential_section, "_DEFAULT_KEYWORD_", i_rep_val=irep, &
2061 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 trim(line)//">")
2074 END IF
2075 ELSE
2076 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 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 IF (read_from_input) THEN
2092 READ (line_att, *) n
2093 CALL remove_word(line_att)
2094 IF (index(line_att, "SOC") /= 0) THEN
2095 potential%soc = .true.
2096 CALL remove_word(line_att)
2097 END IF
2098 ELSE
2099 CALL parser_get_object(parser, n)
2100 IF (parser_test_next_token(parser) == "STR") THEN
2101 CALL parser_get_object(parser, line)
2102 IF (index(line, "SOC") /= 0) potential%soc = .true.
2103 END IF
2104 irep = irep + 1
2105 IF (update_input) THEN
2106 IF (potential%soc) THEN
2107 WRITE (unit=line_att, fmt="(T9,I0,2X,A)") n, "SOC"
2108 ELSE
2109 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 c_val=trim(line_att))
2113 END IF
2114 END IF
2115 potential%lppnl = n - 1
2116 potential%nppnl = 0
2117
2118 potential%lprj_ppnl_max = n - 1
2119 potential%nprj_ppnl_max = 0
2120
2121 IF (n > 0) THEN
2122
2123 lppnl = potential%lppnl
2124 nppnl = potential%nppnl
2125
2126 CALL init_orbital_pointers(lppnl)
2127
2128 NULLIFY (hprj_ppnl, kprj_ppnl)
2129
2130 ! Load the parameter for n non-local projectors
2131
2132 CALL reallocate(potential%alpha_ppnl, 0, lppnl)
2133 CALL reallocate(potential%nprj_ppnl, 0, lppnl)
2134
2135 lprj_ppnl_max = -1
2136 nprj_ppnl_max = 0
2137
2138 DO l = 0, lppnl
2139 IF (read_from_input) THEN
2140 is_ok = cp_sll_val_next(list, val)
2141 IF (.NOT. is_ok) &
2142 CALL cp_abort(__location__, &
2143 "Error while reading GTH potential from input file")
2144 CALL val_get(val, c_val=line_att)
2145 READ (line_att, *) r
2146 CALL remove_word(line_att)
2147 READ (line_att, *) nprj_ppnl
2148 CALL remove_word(line_att)
2149 ELSE
2150 line_att = ""
2151 CALL parser_get_object(parser, r, newline=.true.)
2152 CALL parser_get_object(parser, nprj_ppnl)
2153 istr = len_trim(line_att) + 1
2154 WRITE (unit=line_att(istr:), fmt="(T9,ES25.16E3,1X,I0)") r, nprj_ppnl
2155 END IF
2156 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 trim(potential_file_name)//">")
2162 END IF
2163 potential%alpha_ppnl(l) = 0.0_dp
2164 IF (r /= 0.0_dp .AND. n /= 0) potential%alpha_ppnl(l) = 1.0_dp/(2.0_dp*r**2)
2165 potential%nprj_ppnl(l) = nprj_ppnl
2166 nppnl = nppnl + nprj_ppnl*nco(l)
2167 IF (nprj_ppnl > nprj_ppnl_max) THEN
2168 nprj_ppnl_max = nprj_ppnl
2169 CALL reallocate(hprj_ppnl, 1, nprj_ppnl_max, &
2170 1, nprj_ppnl_max, &
2171 0, lppnl)
2172 CALL reallocate(kprj_ppnl, 1, nprj_ppnl_max, &
2173 1, nprj_ppnl_max, &
2174 0, lppnl)
2175 END IF
2176 DO i = 1, nprj_ppnl
2177 IF (i == 1) THEN
2178 IF (read_from_input) THEN
2179 READ (line_att, *) hprj_ppnl(i, i, l)
2180 CALL remove_word(line_att)
2181 ELSE
2182 CALL parser_get_object(parser, hprj_ppnl(i, i, l))
2183 istr = len_trim(line_att) + 1
2184 WRITE (unit=line_att(istr:), fmt="(ES25.16E3)") hprj_ppnl(i, i, l)
2185 END IF
2186 ELSE
2187 IF (read_from_input) THEN
2188 IF (len_trim(line_att) /= 0) &
2189 CALL cp_abort(__location__, &
2190 "Error while reading GTH potential from input file")
2191 is_ok = cp_sll_val_next(list, val)
2192 IF (.NOT. is_ok) &
2193 CALL cp_abort(__location__, &
2194 "Error while reading GTH potential from input file")
2195 CALL val_get(val, c_val=line_att)
2196 READ (line_att, *) hprj_ppnl(i, i, l)
2197 CALL remove_word(line_att)
2198 ELSE
2199 IF (update_input) THEN
2200 irep = irep + 1
2201 CALL section_vals_val_set(potential_section, "_DEFAULT_KEYWORD_", i_rep_val=irep, &
2202 c_val=trim(line_att))
2203 END IF
2204 line_att = ""
2205 CALL parser_get_object(parser, hprj_ppnl(i, i, l), newline=.true.)
2206 istr = len_trim(line_att) + 1
2207 WRITE (unit=line_att(istr:), fmt="(T36,A,ES25.16E3)") &
2208 repeat(" ", 25*(i - 1)), hprj_ppnl(i, i, l)
2209 END IF
2210 END IF
2211 DO j = i + 1, nprj_ppnl
2212 IF (read_from_input) THEN
2213 READ (line_att, *) hprj_ppnl(i, j, l)
2214 CALL remove_word(line_att)
2215 ELSE
2216 CALL parser_get_object(parser, hprj_ppnl(i, j, l))
2217 istr = len_trim(line_att) + 1
2218 WRITE (unit=line_att(istr:), fmt="(ES25.16E3)") hprj_ppnl(i, j, l)
2219 END IF
2220 END DO
2221 END DO
2222 IF (.NOT. read_from_input) THEN
2223 IF (update_input) THEN
2224 irep = irep + 1
2225 CALL section_vals_val_set(potential_section, "_DEFAULT_KEYWORD_", i_rep_val=irep, &
2226 c_val=trim(line_att))
2227 END IF
2228 line_att = ""
2229 ELSE
2230 IF (len_trim(line_att) /= 0) THEN
2231 CALL cp_abort(__location__, &
2232 "Error while reading GTH potential from input file")
2233 END IF
2234 END IF
2235 IF (nprj_ppnl > 1) THEN
2236 CALL symmetrize_matrix(hprj_ppnl(:, :, l), "upper_to_lower")
2237 END IF
2238 IF (potential%soc .AND. (l > 0)) THEN
2239 ! Read non-local parameters for spin-orbit coupling
2240 DO i = 1, nprj_ppnl
2241 IF (read_from_input) THEN
2242 IF (len_trim(line_att) /= 0) &
2243 CALL cp_abort(__location__, &
2244 "Error while reading GTH potential from input file")
2245 is_ok = cp_sll_val_next(list, val)
2246 IF (.NOT. is_ok) &
2247 CALL cp_abort(__location__, &
2248 "Error while reading GTH potential from input file")
2249 CALL val_get(val, c_val=line_att)
2250 READ (line_att, *) kprj_ppnl(i, i, l)
2251 CALL remove_word(line_att)
2252 ELSE
2253 IF (i > 1 .AND. update_input) THEN
2254 irep = irep + 1
2255 CALL section_vals_val_set(potential_section, "_DEFAULT_KEYWORD_", i_rep_val=irep, &
2256 c_val=trim(line_att))
2257 END IF
2258 line_att = ""
2259 CALL parser_get_object(parser, kprj_ppnl(i, i, l), newline=.true.)
2260 istr = len_trim(line_att) + 1
2261 WRITE (unit=line_att(istr:), fmt="(T36,A,ES25.16E3)") &
2262 repeat(" ", 25*(i - 1)), kprj_ppnl(i, i, l)
2263 END IF
2264 DO j = i + 1, nprj_ppnl
2265 IF (read_from_input) THEN
2266 READ (line_att, *) kprj_ppnl(i, j, l)
2267 CALL remove_word(line_att)
2268 ELSE
2269 CALL parser_get_object(parser, kprj_ppnl(i, j, l))
2270 istr = len_trim(line_att) + 1
2271 WRITE (unit=line_att(istr:), fmt="(ES25.16E3)") kprj_ppnl(i, j, l)
2272 END IF
2273 END DO
2274 END DO
2275 IF (read_from_input) THEN
2276 IF (len_trim(line_att) /= 0) THEN
2277 CALL cp_abort(__location__, &
2278 "Error while reading GTH potential from input file")
2279 END IF
2280 ELSE
2281 IF (update_input) THEN
2282 irep = irep + 1
2283 CALL section_vals_val_set(potential_section, "_DEFAULT_KEYWORD_", i_rep_val=irep, &
2284 c_val=trim(line_att))
2285 END IF
2286 line_att = ""
2287 END IF
2288 IF (nprj_ppnl > 1) THEN
2289 CALL symmetrize_matrix(kprj_ppnl(:, :, l), "upper_to_lower")
2290 END IF
2291 END IF ! SOC
2292 lprj_ppnl_max = max(lprj_ppnl_max, l + 2*(nprj_ppnl - 1))
2293 END DO ! lppnl
2294
2295 potential%nppnl = nppnl
2296 CALL init_orbital_pointers(lprj_ppnl_max)
2297
2298 potential%lprj_ppnl_max = lprj_ppnl_max
2299 potential%nprj_ppnl_max = nprj_ppnl_max
2300 CALL reallocate(potential%hprj_ppnl, 1, nprj_ppnl_max, &
2301 1, nprj_ppnl_max, &
2302 0, lppnl)
2303 potential%hprj_ppnl(:, :, :) = hprj_ppnl(:, :, :)
2304 CALL reallocate(potential%kprj_ppnl, 1, nprj_ppnl_max, &
2305 1, nprj_ppnl_max, &
2306 0, lppnl)
2307 potential%kprj_ppnl(:, :, :) = kprj_ppnl(:, :, :)
2308
2309 CALL reallocate(potential%cprj, 1, ncoset(lprj_ppnl_max), 1, nppnl)
2310 CALL reallocate(potential%cprj_ppnl, 1, nprj_ppnl_max, 0, lppnl)
2311 CALL reallocate(potential%vprj_ppnl, 1, nppnl, 1, nppnl)
2312 CALL reallocate(potential%wprj_ppnl, 1, nppnl, 1, nppnl)
2313
2314 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 trim(potential_file_name)//">")
2327 END IF
2328 END DO search_loop
2329
2330 IF (.NOT. read_from_input) THEN
2331 ! Dump the potential info in the potential section
2332 IF (match .AND. update_input) THEN
2333 irep = irep + 1
2334 WRITE (unit=line_att, fmt="(T9,A)") &
2335 "# Potential name: "//trim(adjustl(apname2(:strlen2)))// &
2336 " for element symbol: "//trim(adjustl(symbol2(:strlen1)))
2337 CALL section_vals_val_set(potential_section, "_DEFAULT_KEYWORD_", i_rep_val=irep, &
2338 c_val=trim(line_att))
2339 irep = irep + 1
2340 WRITE (unit=line_att, fmt="(T9,A)") &
2341 "# 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 c_val=trim(line_att))
2344 END IF
2345 CALL parser_release(parser)
2346 DEALLOCATE (parser)
2347 END IF
2348
2349 IF (ASSOCIATED(tmp_vals)) DEALLOCATE (tmp_vals)
2350
2351 END SUBROUTINE read_gth_potential
2352
2353! **************************************************************************************************
2354!> \brief ...
2355!> \param potential ...
2356!> \param z ...
2357!> \param zeff_correction ...
2358! **************************************************************************************************
2359 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 ALLOCATE (elec_conf(0:3))
2371 elec_conf(0:3) = ptable(z)%e_conv(0:3)
2372 zeff = real(sum(elec_conf), dp) + zeff_correction
2373 name = ptable(z)%name
2374
2375 r = ptable(z)%covalent_radius*0.5_dp
2376 r = max(r, 0.2_dp)
2377 r = min(r, 1.0_dp)
2378 alpha = 1.0_dp/(2.0_dp*r**2)
2379
2380 core_charge_radius = r
2381 alpha_core_charge = alpha
2382 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 elec_conf=elec_conf)
2393
2394 DEALLOCATE (elec_conf)
2395
2396 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 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 IF (PRESENT(name)) potential%name = name
2427 IF (PRESENT(alpha_core_charge)) &
2428 potential%alpha_core_charge = alpha_core_charge
2429 IF (PRESENT(ccore_charge)) potential%ccore_charge = ccore_charge
2430 IF (PRESENT(core_charge_radius)) &
2431 potential%core_charge_radius = core_charge_radius
2432 IF (PRESENT(z)) potential%z = z
2433 IF (PRESENT(zeff)) potential%zeff = zeff
2434 IF (PRESENT(zeff_correction)) potential%zeff_correction = zeff_correction
2435 IF (PRESENT(elec_conf)) THEN
2436 IF (.NOT. ASSOCIATED(potential%elec_conf)) THEN
2437 CALL reallocate(potential%elec_conf, 0, SIZE(elec_conf) - 1)
2438 END IF
2439 potential%elec_conf(:) = elec_conf(:)
2440 END IF
2441
2442 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 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 IF (PRESENT(name)) potential%name = name
2465 IF (PRESENT(alpha)) potential%alpha => alpha
2466 IF (PRESENT(cval)) potential%cval => cval
2467 IF (PRESENT(radius)) potential%radius = radius
2468
2469 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 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 IF (PRESENT(apol)) potential%apol = apol
2492 IF (PRESENT(cpol)) potential%cpol = cpol
2493 IF (PRESENT(mm_radius)) potential%mm_radius = mm_radius
2494 IF (PRESENT(qeff)) potential%qeff = qeff
2495 IF (PRESENT(qmmm_corr_radius)) potential%qmmm_corr_radius = qmmm_corr_radius
2496 IF (PRESENT(qmmm_radius)) potential%qmmm_radius = qmmm_radius
2497
2498 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 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 IF (PRESENT(name)) potential%name = name
2557 IF (PRESENT(alpha_core_charge)) &
2558 potential%alpha_core_charge = alpha_core_charge
2559 IF (PRESENT(alpha_ppl)) potential%alpha_ppl = alpha_ppl
2560 IF (PRESENT(ccore_charge)) potential%ccore_charge = ccore_charge
2561 IF (PRESENT(cerf_ppl)) potential%cerf_ppl = cerf_ppl
2562 IF (PRESENT(core_charge_radius)) &
2563 potential%core_charge_radius = core_charge_radius
2564 IF (PRESENT(ppl_radius)) potential%ppl_radius = ppl_radius
2565 IF (PRESENT(ppnl_radius)) potential%ppnl_radius = ppnl_radius
2566 IF (PRESENT(lppnl)) potential%lppnl = lppnl
2567 IF (PRESENT(lprj_ppnl_max)) potential%lprj_ppnl_max = lprj_ppnl_max
2568 IF (PRESENT(nexp_ppl)) potential%nexp_ppl = nexp_ppl
2569 IF (PRESENT(nppnl)) potential%nppnl = nppnl
2570 IF (PRESENT(nprj_ppnl_max)) potential%nprj_ppnl_max = nprj_ppnl_max
2571 IF (PRESENT(z)) potential%z = z
2572 IF (PRESENT(zeff)) potential%zeff = zeff
2573 IF (PRESENT(zeff_correction)) potential%zeff_correction = zeff_correction
2574 IF (PRESENT(alpha_ppnl)) potential%alpha_ppnl => alpha_ppnl
2575 IF (PRESENT(cexp_ppl)) potential%cexp_ppl => cexp_ppl
2576 IF (PRESENT(elec_conf)) THEN
2577 IF (ASSOCIATED(potential%elec_conf)) THEN
2578 DEALLOCATE (potential%elec_conf)
2579 END IF
2580 ALLOCATE (potential%elec_conf(0:SIZE(elec_conf) - 1))
2581 potential%elec_conf(:) = elec_conf(:)
2582 END IF
2583 IF (PRESENT(nprj_ppnl)) potential%nprj_ppnl => nprj_ppnl
2584 IF (PRESENT(cprj)) potential%cprj => cprj
2585 IF (PRESENT(cprj_ppnl)) potential%cprj_ppnl => cprj_ppnl
2586 IF (PRESENT(hprj_ppnl)) potential%hprj_ppnl => hprj_ppnl
2587 IF (PRESENT(kprj_ppnl)) potential%kprj_ppnl => kprj_ppnl
2588 IF (PRESENT(vprj_ppnl)) potential%vprj_ppnl => vprj_ppnl
2589 IF (PRESENT(wprj_ppnl)) potential%wprj_ppnl => wprj_ppnl
2590
2591 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 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 IF (PRESENT(name)) potential%name = name
2679 IF (PRESENT(aliases)) potential%aliases = aliases
2680 IF (PRESENT(description)) potential%description = description
2681
2682 IF (PRESENT(elec_conf)) THEN
2683 IF (ASSOCIATED(potential%elec_conf)) THEN
2684 DEALLOCATE (potential%elec_conf)
2685 END IF
2686 ALLOCATE (potential%elec_conf(0:SIZE(elec_conf) - 1))
2687 potential%elec_conf(:) = elec_conf(:)
2688 END IF
2689
2690 IF (PRESENT(z)) potential%z = z
2691 IF (PRESENT(zeff)) potential%zeff = zeff
2692 IF (PRESENT(zeff_correction)) potential%zeff_correction = zeff_correction
2693 IF (PRESENT(alpha_core_charge)) potential%alpha_core_charge = alpha_core_charge
2694 IF (PRESENT(ccore_charge)) potential%ccore_charge = ccore_charge
2695 IF (PRESENT(core_charge_radius)) potential%core_charge_radius = core_charge_radius
2696
2697 IF (PRESENT(ppl_radius)) potential%ppl_radius = ppl_radius
2698 IF (PRESENT(ppnl_radius)) potential%ppnl_radius = ppnl_radius
2699
2700 IF (PRESENT(ecp_local)) potential%ecp_local = ecp_local
2701 IF (PRESENT(n_local)) potential%n_local = n_local
2702 IF (PRESENT(a_local)) potential%a_local => a_local
2703 IF (PRESENT(c_local)) potential%c_local => c_local
2704
2705 IF (PRESENT(nloc)) potential%nloc = nloc
2706 IF (PRESENT(nrloc)) potential%nrloc = nrloc
2707 IF (PRESENT(aloc)) potential%aloc = aloc
2708 IF (PRESENT(bloc)) potential%bloc = bloc
2709
2710 IF (PRESENT(ecp_semi_local)) potential%ecp_semi_local = ecp_semi_local
2711 IF (PRESENT(sl_lmax)) potential%sl_lmax = sl_lmax
2712 IF (PRESENT(npot)) potential%npot = npot
2713 IF (PRESENT(nrpot)) potential%nrpot = nrpot
2714 IF (PRESENT(apot)) potential%apot = apot
2715 IF (PRESENT(bpot)) potential%bpot = bpot
2716
2717 IF (PRESENT(n_nonlocal)) potential%n_nonlocal = n_nonlocal
2718 IF (PRESENT(nppnl)) potential%nppnl = nppnl
2719 IF (PRESENT(lmax)) potential%lmax = lmax
2720 IF (PRESENT(is_nonlocal)) potential%is_nonlocal(:) = is_nonlocal(:)
2721 IF (PRESENT(a_nonlocal)) potential%a_nonlocal => a_nonlocal
2722 IF (PRESENT(c_nonlocal)) potential%c_nonlocal => c_nonlocal
2723 IF (PRESENT(h_nonlocal)) potential%h_nonlocal => h_nonlocal
2724
2725 IF (PRESENT(has_nlcc)) potential%has_nlcc = has_nlcc
2726 IF (PRESENT(n_nlcc)) potential%n_nlcc = n_nlcc
2727 IF (PRESENT(a_nlcc)) potential%a_nlcc => a_nlcc
2728 IF (PRESENT(c_nlcc)) potential%c_nlcc => c_nlcc
2729
2730 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 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 IF (output_unit > 0) THEN
2747 WRITE (unit=output_unit, fmt="(/,T6,A,T41,A40,/)") &
2748 "AE Potential information for", adjustr(trim(potential%name))
2749 WRITE (unit=output_unit, fmt="(T8,A,T41,A40)") &
2750 "Description: ", trim(potential%description(1)), &
2751 " ", trim(potential%description(2))
2752 WRITE (unit=output_unit, fmt="(/,T8,A,T69,F12.6)") &
2753 "Gaussian exponent of the core charge distribution: ", &
2754 potential%alpha_core_charge
2755 WRITE (unit=string, fmt="(5I4)") potential%elec_conf
2756 WRITE (unit=output_unit, fmt="(T8,A,T61,A20)") &
2757 "Electronic configuration (s p d ...):", &
2758 adjustr(trim(string))
2759 END IF
2760
2761 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 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 IF (output_unit > 0) THEN
2778 WRITE (unit=output_unit, fmt="(/,T6,A,T41,A40)") &
2779 "Local Potential information for", adjustr(trim(potential%name))
2780 WRITE (unit=output_unit, fmt="(T8,A,T41,A40)") &
2781 "Description: ", trim(potential%description(1))
2782 DO igau = 1, potential%ngau
2783 WRITE (unit=output_unit, fmt="(T8,A,F12.6,T50,A,4(T68,I2,F10.4))") &
2784 "Exponent: ", potential%alpha(igau), &
2785 "Coefficients: ", (2*ipol - 2, potential%cval(igau, ipol), ipol=1, potential%npol)
2786 END DO
2787 END IF
2788
2789 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 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 IF (output_unit > 0) THEN
2808 WRITE (unit=output_unit, fmt="(/,T6,A,T41,A40,/)") &
2809 "GTH Potential information for", adjustr(trim(potential%name))
2810 WRITE (unit=output_unit, fmt="(T8,A,T41,A40)") &
2811 "Description: ", adjustr(trim(potential%description(1))), &
2812 " ", adjustr(trim(potential%description(2))), &
2813 " ", adjustr(trim(potential%description(3))), &
2814 " ", adjustr(trim(potential%description(4)))
2815 WRITE (unit=output_unit, fmt="(/,T8,A,T69,F12.6)") &
2816 "Gaussian exponent of the core charge distribution: ", &
2817 potential%alpha_core_charge
2818 WRITE (unit=string, fmt="(5I4)") potential%elec_conf
2819 WRITE (unit=output_unit, fmt="(T8,A,T61,A20)") &
2820 "Electronic configuration (s p d ...):", &
2821 adjustr(trim(string))
2822
2823 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 "Parameters of the local part of the GTH pseudopotential:", &
2827 "rloc C1 C2 C3 C4", &
2828 r, (potential%cexp_ppl(i)*r**(2*(i - 1)), i=1, potential%nexp_ppl)
2829
2830 IF (potential%lppnl > -1) THEN
2831 IF (potential%soc) THEN
2832 WRITE (unit=output_unit, fmt="(/,T8,A,/,/,(T20,A))") &
2833 "Parameters of the non-local part of the GTH (SOC) pseudopotential:", &
2834 "l r(l) h(i,j,l)", &
2835 " k(i,j,l)"
2836 ELSE
2837 WRITE (unit=output_unit, fmt="(/,T8,A,/,/,T20,A,/)") &
2838 "Parameters of the non-local part of the GTH pseudopotential:", &
2839 "l r(l) h(i,j,l)"
2840 END IF
2841 DO l = 0, potential%lppnl
2842 r = sqrt(0.5_dp/potential%alpha_ppnl(l))
2843 WRITE (unit=output_unit, fmt="(T19,I2,5F12.6)") &
2844 l, r, (potential%hprj_ppnl(1, j, l), j=1, potential%nprj_ppnl(l))
2845 DO i = 2, potential%nprj_ppnl(l)
2846 WRITE (unit=output_unit, fmt="(T33,4F12.6)") &
2847 (potential%hprj_ppnl(i, j, l), j=1, potential%nprj_ppnl(l))
2848 END DO
2849 IF (potential%soc .AND. (l > 0)) THEN
2850 DO i = 1, potential%nprj_ppnl(l)
2851 WRITE (unit=output_unit, fmt="(T33,4F12.6)") &
2852 (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 END SUBROUTINE write_gth_potential
2860
2861! **************************************************************************************************
2862!> \brief ...
2863!> \param potential ...
2864!> \param output_unit ...
2865! **************************************************************************************************
2866 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 IF (output_unit > 0) THEN
2877 WRITE (unit=output_unit, fmt="(/,T6,A,T41,A40,/)") &
2878 "SGP Potential information for", adjustr(trim(potential%name))
2879 WRITE (unit=output_unit, fmt="(T8,A,T25,A56)") &
2880 "Description: ", adjustr(trim(potential%description(1))), &
2881 " ", adjustr(trim(potential%description(2))), &
2882 " ", adjustr(trim(potential%description(3))), &
2883 " ", adjustr(trim(potential%description(4)))
2884 WRITE (unit=output_unit, fmt="(/,T8,A,T69,F12.6)") &
2885 "Gaussian exponent of the core charge distribution: ", &
2886 potential%alpha_core_charge
2887 WRITE (unit=string, fmt="(10I4)") potential%elec_conf
2888 WRITE (unit=output_unit, fmt="(T8,A,T61,A20)") &
2889 "Electronic configuration (s p d ...):", &
2890 adjustr(trim(string))
2891 IF (potential%ecp_local) THEN
2892 IF (potential%nloc > 0) THEN
2893 WRITE (unit=output_unit, fmt="(/,T8,'Local pseudopotential')")
2894 WRITE (unit=output_unit, fmt="(T20,'r**(n-2)',T50,'Coefficient',T73,'Exponent')")
2895 DO i = 1, potential%nloc
2896 WRITE (unit=output_unit, fmt="(T20,I5,T47,F14.8,T69,F12.6)") &
2897 potential%nrloc(i), potential%aloc(i), potential%bloc(i)
2898 END DO
2899 END IF
2900 ELSE
2901 IF (potential%n_local > 0) THEN
2902 WRITE (unit=output_unit, fmt="(/,T8,'Local pseudopotential')")
2903 WRITE (unit=output_unit, fmt="(T8,A,10(T21,6F10.4,/))") &
2904 'Exponents:', potential%a_local(1:potential%n_local)
2905 WRITE (unit=output_unit, fmt="(T8,A,10(T21,6F10.4,/))") &
2906 'Coefficients:', potential%c_local(1:potential%n_local)
2907 END IF
2908 END IF
2909 IF (potential%ecp_semi_local) THEN
2910 WRITE (unit=output_unit, fmt="(/,T8,'Semi-local pseudopotential')")
2911 DO l = 0, potential%sl_lmax
2912 WRITE (unit=output_unit, fmt="(T8,A,A)") 'l-value: ', slqval(l)
2913 DO i = 1, potential%npot(l)
2914 WRITE (unit=output_unit, fmt="(T21,I5,2F20.8)") &
2915 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 IF (potential%n_nonlocal > 0) THEN
2921 WRITE (unit=output_unit, fmt="(/,T8,'Nonlocal pseudopotential')")
2922 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 'Exponents:', potential%a_nonlocal(1:potential%n_nonlocal)
2925 DO l = 0, potential%lmax
2926 WRITE (unit=output_unit, fmt="(T8,'Coupling for l=',I4)") l
2927 WRITE (unit=output_unit, fmt="(10(T21,6F10.4,/))") &
2928 potential%h_nonlocal(1:potential%n_nonlocal, l)
2929 END DO
2930 END IF
2931 !
2932 IF (potential%has_nlcc) THEN
2933 WRITE (unit=output_unit, fmt="(/,T8,'Nonlinear Core Correction')")
2934 WRITE (unit=output_unit, fmt="(T8,A,10(T21,6F10.4,/))") &
2935 'Exponents:', potential%a_nlcc(1:potential%n_nlcc)
2936 WRITE (unit=output_unit, fmt="(T8,A,10(T21,6F10.4,/))") &
2937 'Coefficients:', potential%c_nlcc(1:potential%n_nlcc)
2938 END IF
2939 END IF
2940
2941 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 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 CALL allocate_all_potential(pot_out)
2956
2957 pot_out%name = pot_in%name
2958 pot_out%alpha_core_charge = pot_in%alpha_core_charge
2959 pot_out%ccore_charge = pot_in%ccore_charge
2960 pot_out%core_charge_radius = pot_in%core_charge_radius
2961 pot_out%zeff = pot_in%zeff
2962 pot_out%zeff_correction = pot_in%zeff_correction
2963 pot_out%z = pot_in%z
2964
2965 IF (ASSOCIATED(pot_in%elec_conf)) THEN
2966 ALLOCATE (pot_out%elec_conf(lbound(pot_in%elec_conf, 1):ubound(pot_in%elec_conf, 1)))
2967 pot_out%elec_conf(:) = pot_in%elec_conf(:)
2968 END IF
2969
2970 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 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 CALL allocate_gth_potential(pot_out)
2985
2986 pot_out%name = pot_in%name
2987 pot_out%aliases = pot_in%aliases
2988 pot_out%alpha_core_charge = pot_in%alpha_core_charge
2989 pot_out%alpha_ppl = pot_in%alpha_ppl
2990 pot_out%ccore_charge = pot_in%ccore_charge
2991 pot_out%cerf_ppl = pot_in%cerf_ppl
2992 pot_out%zeff = pot_in%zeff
2993 pot_out%core_charge_radius = pot_in%core_charge_radius
2994 pot_out%ppl_radius = pot_in%ppl_radius
2995 pot_out%ppnl_radius = pot_in%ppnl_radius
2996 pot_out%zeff_correction = pot_in%zeff_correction
2997 pot_out%lppnl = pot_in%lppnl
2998 pot_out%lprj_ppnl_max = pot_in%lprj_ppnl_max
2999 pot_out%nexp_ppl = pot_in%nexp_ppl
3000 pot_out%nppnl = pot_in%nppnl
3001 pot_out%nprj_ppnl_max = pot_in%nprj_ppnl_max
3002 pot_out%z = pot_in%z
3003 pot_out%nlcc = pot_in%nlcc
3004 pot_out%nexp_nlcc = pot_in%nexp_nlcc
3005 pot_out%lsdpot = pot_in%lsdpot
3006 pot_out%nexp_lsd = pot_in%nexp_lsd
3007 pot_out%lpotextended = pot_in%lpotextended
3008 pot_out%nexp_lpot = pot_in%nexp_lpot
3009
3010 IF (ASSOCIATED(pot_in%alpha_ppnl)) THEN
3011 ALLOCATE (pot_out%alpha_ppnl(lbound(pot_in%alpha_ppnl, 1):ubound(pot_in%alpha_ppnl, 1)))
3012 pot_out%alpha_ppnl(:) = pot_in%alpha_ppnl(:)
3013 END IF
3014 IF (ASSOCIATED(pot_in%cexp_ppl)) THEN
3015 ALLOCATE (pot_out%cexp_ppl(lbound(pot_in%cexp_ppl, 1):ubound(pot_in%cexp_ppl, 1)))
3016 pot_out%cexp_ppl(:) = pot_in%cexp_ppl(:)
3017 END IF
3018 IF (ASSOCIATED(pot_in%elec_conf)) THEN
3019 ALLOCATE (pot_out%elec_conf(lbound(pot_in%elec_conf, 1):ubound(pot_in%elec_conf, 1)))
3020 pot_out%elec_conf(:) = pot_in%elec_conf(:)
3021 END IF
3022 IF (ASSOCIATED(pot_in%nprj_ppnl)) THEN
3023 ALLOCATE (pot_out%nprj_ppnl(lbound(pot_in%nprj_ppnl, 1):ubound(pot_in%nprj_ppnl, 1)))
3024 pot_out%nprj_ppnl(:) = pot_in%nprj_ppnl(:)
3025 END IF
3026 IF (ASSOCIATED(pot_in%cprj)) THEN
3027 ALLOCATE (pot_out%cprj(lbound(pot_in%cprj, 1):ubound(pot_in%cprj, 1), &
3028 lbound(pot_in%cprj, 2):ubound(pot_in%cprj, 2)))
3029 pot_out%cprj(:, :) = pot_in%cprj(:, :)
3030 END IF
3031 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 lbound(pot_in%cprj_ppnl, 2):ubound(pot_in%cprj_ppnl, 2)))
3034 pot_out%cprj_ppnl(:, :) = pot_in%cprj_ppnl(:, :)
3035 END IF
3036 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 lbound(pot_in%hprj_ppnl, 3):ubound(pot_in%hprj_ppnl, 3)))
3040 pot_out%hprj_ppnl(:, :, :) = pot_in%hprj_ppnl(:, :, :)
3041 END IF
3042 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 lbound(pot_in%kprj_ppnl, 3):ubound(pot_in%kprj_ppnl, 3)))
3046 pot_out%kprj_ppnl(:, :, :) = pot_in%kprj_ppnl(:, :, :)
3047 END IF
3048 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 lbound(pot_in%vprj_ppnl, 2):ubound(pot_in%vprj_ppnl, 2)))
3051 pot_out%vprj_ppnl(:, :) = pot_in%vprj_ppnl(:, :)
3052 END IF
3053 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 lbound(pot_in%wprj_ppnl, 2):ubound(pot_in%wprj_ppnl, 2)))
3056 pot_out%wprj_ppnl(:, :) = pot_in%wprj_ppnl(:, :)
3057 END IF
3058 IF (ASSOCIATED(pot_in%alpha_nlcc)) THEN
3059 ALLOCATE (pot_out%alpha_nlcc(lbound(pot_in%alpha_nlcc, 1):ubound(pot_in%alpha_nlcc, 1)))
3060 pot_out%alpha_nlcc(:) = pot_in%alpha_nlcc(:)
3061 END IF
3062 IF (ASSOCIATED(pot_in%nct_nlcc)) THEN
3063 ALLOCATE (pot_out%nct_nlcc(lbound(pot_in%nct_nlcc, 1):ubound(pot_in%nct_nlcc, 1)))
3064 pot_out%nct_nlcc(:) = pot_in%nct_nlcc(:)
3065 END IF
3066 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 lbound(pot_in%cval_nlcc, 2):ubound(pot_in%cval_nlcc, 2)))
3069 pot_out%cval_nlcc(:, :) = pot_in%cval_nlcc(:, :)
3070 END IF
3071 IF (ASSOCIATED(pot_in%alpha_lsd)) THEN
3072 ALLOCATE (pot_out%alpha_lsd(lbound(pot_in%alpha_lsd, 1):ubound(pot_in%alpha_lsd, 1)))
3073 pot_out%alpha_lsd(:) = pot_in%alpha_lsd(:)
3074 END IF
3075 IF (ASSOCIATED(pot_in%nct_lsd)) THEN
3076 ALLOCATE (pot_out%nct_lsd(lbound(pot_in%nct_lsd, 1):ubound(pot_in%nct_lsd, 1)))
3077 pot_out%nct_lsd(:) = pot_in%nct_lsd(:)
3078 END IF
3079 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 lbound(pot_in%cval_lsd, 2):ubound(pot_in%cval_lsd, 2)))
3082 pot_out%cval_lsd(:, :) = pot_in%cval_lsd(:, :)
3083 END IF
3084 IF (ASSOCIATED(pot_in%alpha_lpot)) THEN
3085 ALLOCATE (pot_out%alpha_lpot(lbound(pot_in%alpha_lpot, 1):ubound(pot_in%alpha_lpot, 1)))
3086 pot_out%alpha_lpot(:) = pot_in%alpha_lpot(:)
3087 END IF
3088 IF (ASSOCIATED(pot_in%nct_lpot)) THEN
3089 ALLOCATE (pot_out%nct_lpot(lbound(pot_in%nct_lpot, 1):ubound(pot_in%nct_lpot, 1)))
3090 pot_out%nct_lpot(:) = pot_in%nct_lpot(:)
3091 END IF
3092 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 lbound(pot_in%cval_lpot, 2):ubound(pot_in%cval_lpot, 2)))
3095 pot_out%cval_lpot(:, :) = pot_in%cval_lpot(:, :)
3096 END IF
3097
3098 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 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 CALL allocate_sgp_potential(pot_out)
3113
3114 pot_out%name = pot_in%name
3115 pot_out%aliases = pot_in%aliases
3116 pot_out%z = pot_in%z
3117 pot_out%zeff = pot_in%zeff
3118 pot_out%zeff_correction = pot_in%zeff_correction
3119 pot_out%alpha_core_charge = pot_in%alpha_core_charge
3120 pot_out%ccore_charge = pot_in%ccore_charge
3121 pot_out%core_charge_radius = pot_in%core_charge_radius
3122 pot_out%ppl_radius = pot_in%ppl_radius
3123 pot_out%ppnl_radius = pot_in%ppnl_radius
3124 pot_out%ecp_local = pot_in%ecp_local
3125 pot_out%n_local = pot_in%n_local
3126 pot_out%nloc = pot_in%nloc
3127 pot_out%nrloc = pot_in%nrloc
3128 pot_out%aloc = pot_in%aloc
3129 pot_out%bloc = pot_in%bloc
3130 pot_out%ecp_semi_local = pot_in%ecp_semi_local
3131 pot_out%sl_lmax = pot_in%sl_lmax
3132 pot_out%npot = pot_in%npot
3133 pot_out%nrpot = pot_in%nrpot
3134 pot_out%apot = pot_in%apot
3135 pot_out%bpot = pot_in%bpot
3136 pot_out%n_nonlocal = pot_in%n_nonlocal
3137 pot_out%nppnl = pot_in%nppnl
3138 pot_out%lmax = pot_in%lmax
3139 pot_out%is_nonlocal = pot_in%is_nonlocal
3140 pot_out%has_nlcc = pot_in%has_nlcc
3141 pot_out%n_nlcc = pot_in%n_nlcc
3142
3143 IF (ASSOCIATED(pot_in%elec_conf)) THEN
3144 ALLOCATE (pot_out%elec_conf(lbound(pot_in%elec_conf, 1):ubound(pot_in%elec_conf, 1)))
3145 pot_out%elec_conf(:) = pot_in%elec_conf(:)
3146 END IF
3147 IF (ASSOCIATED(pot_in%a_local)) THEN
3148 ALLOCATE (pot_out%a_local(lbound(pot_in%a_local, 1):ubound(pot_in%a_local, 1)))
3149 pot_out%a_local(:) = pot_in%a_local(:)
3150 END IF
3151 IF (ASSOCIATED(pot_in%c_local)) THEN
3152 ALLOCATE (pot_out%c_local(lbound(pot_in%c_local, 1):ubound(pot_in%c_local, 1)))
3153 pot_out%c_local(:) = pot_in%c_local(:)
3154 END IF
3155 IF (ASSOCIATED(pot_in%a_nonlocal)) THEN
3156 ALLOCATE (pot_out%a_nonlocal(lbound(pot_in%a_nonlocal, 1):ubound(pot_in%a_nonlocal, 1)))
3157 pot_out%a_nonlocal(:) = pot_in%a_nonlocal(:)
3158 END IF
3159 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 lbound(pot_in%h_nonlocal, 2):ubound(pot_in%h_nonlocal, 2)))
3162 pot_out%h_nonlocal(:, :) = pot_in%h_nonlocal(:, :)
3163 END IF
3164 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 lbound(pot_in%c_nonlocal, 3):ubound(pot_in%c_nonlocal, 3)))
3168 pot_out%c_nonlocal(:, :, :) = pot_in%c_nonlocal(:, :, :)
3169 END IF
3170 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 lbound(pot_in%cprj_ppnl, 2):ubound(pot_in%cprj_ppnl, 2)))
3173 pot_out%cprj_ppnl(:, :) = pot_in%cprj_ppnl(:, :)
3174 END IF
3175 IF (ASSOCIATED(pot_in%vprj_ppnl)) THEN
3176 ALLOCATE (pot_out%vprj_ppnl(lbound(pot_in%vprj_ppnl, 1):ubound(pot_in%vprj_ppnl, 1)))
3177 pot_out%vprj_ppnl(:) = pot_in%vprj_ppnl(:)
3178 END IF
3179 IF (ASSOCIATED(pot_in%a_nlcc)) THEN
3180 ALLOCATE (pot_out%a_nlcc(lbound(pot_in%a_nlcc, 1):ubound(pot_in%a_nlcc, 1)))
3181 pot_out%a_nlcc(:) = pot_in%a_nlcc(:)
3182 END IF
3183 IF (ASSOCIATED(pot_in%c_nlcc)) THEN
3184 ALLOCATE (pot_out%c_nlcc(lbound(pot_in%c_nlcc, 1):ubound(pot_in%c_nlcc, 1)))
3185 pot_out%c_nlcc(:) = pot_in%c_nlcc(:)
3186 END IF
3187
3188 END SUBROUTINE copy_sgp_potential
3189
3190END MODULE external_potential_types
cp_parser_methods::parser_get_object
Definition cp_parser_methods.F:54
external_potential_types::allocate_potential
Definition external_potential_types.F:260
external_potential_types::copy_potential
Definition external_potential_types.F:311
external_potential_types::deallocate_potential
Definition external_potential_types.F:268
external_potential_types::get_potential
Definition external_potential_types.F:276
external_potential_types::init_potential
Definition external_potential_types.F:284
external_potential_types::read_potential
Definition external_potential_types.F:290
external_potential_types::set_potential
Definition external_potential_types.F:296
external_potential_types::write_potential
Definition external_potential_types.F:304
memory_utilities::reallocate
Definition memory_utilities.F:27
ao_util
All kind of helpful little routines.
Definition ao_util.F:14
ao_util::exp_radius
real(kind=dp) function, public exp_radius(l, alpha, threshold, prefactor, epsabs, epsrel, rlow)
The radius of a primitive Gaussian function for a given threshold is calculated. g(r) = prefactor*r**...
Definition ao_util.F:96
bibliography
collects all references to literature in CP2K as new algorithms / method are included from literature...
Definition bibliography.F:21
bibliography::goedecker1996
integer, save, public goedecker1996
Definition bibliography.F:36
bibliography::hartwigsen1998
integer, save, public hartwigsen1998
Definition bibliography.F:36
bibliography::krack2000
integer, save, public krack2000
Definition bibliography.F:36
bibliography::krack2005
integer, save, public krack2005
Definition bibliography.F:36
cp_linked_list_input
Definition cp_linked_list_input.F:9
cp_linked_list_input::cp_sll_val_next
logical function, public cp_sll_val_next(iterator, el_att)
returns true if the actual element is valid (i.e. iterator ont at end) moves the iterator to the next...
Definition cp_linked_list_input.F:1474
cp_parser_methods
Utility routines to read data from files. Kept as close as possible to the old parser because.
Definition cp_parser_methods.F:20
cp_parser_methods::parser_get_next_line
subroutine, public parser_get_next_line(parser, nline, at_end)
Read the next input line and broadcast the input information. Skip (nline-1) lines and skip also all ...
Definition cp_parser_methods.F:421
cp_parser_methods::parser_test_next_token
character(len=3) function, public parser_test_next_token(parser, string_length)
Test next input object.
Definition cp_parser_methods.F:691
cp_parser_methods::parser_search_string
subroutine, public parser_search_string(parser, string, ignore_case, found, line, begin_line, search_from_begin_of_file)
Search a string pattern in a file defined by its logical unit number "unit". A case sensitive search ...
Definition cp_parser_methods.F:786
cp_parser_types
Utility routines to read data from files. Kept as close as possible to the old parser because.
Definition cp_parser_types.F:21
cp_parser_types::parser_release
subroutine, public parser_release(parser)
releases the parser
Definition cp_parser_types.F:109
cp_parser_types::parser_create
subroutine, public parser_create(parser, file_name, unit_nr, para_env, end_section_label, separator_chars, comment_char, continuation_char, quote_char, section_char, parse_white_lines, initial_variables, apply_preprocessing)
Start a parser run. Initial variables allow to @SET stuff before opening the file.
Definition cp_parser_types.F:147
external_potential_types
Definition of the atomic potential types.
Definition external_potential_types.F:14
external_potential_types::set_default_all_potential
subroutine, public set_default_all_potential(potential, z, zeff_correction)
...
Definition external_potential_types.F:2360
input_section_types
objects that represent the structure of input sections and the data contained in an input section
Definition input_section_types.F:15
input_section_types::section_vals_val_set
subroutine, public section_vals_val_set(section_vals, keyword_name, i_rep_section, i_rep_val, val, l_val, i_val, r_val, c_val, l_vals_ptr, i_vals_ptr, r_vals_ptr, c_vals_ptr)
sets the requested value
Definition input_section_types.F:1223
input_section_types::section_vals_list_get
subroutine, public section_vals_list_get(section_vals, keyword_name, i_rep_section, list)
returns the requested list
Definition input_section_types.F:1156
input_section_types::section_vals_get
subroutine, public section_vals_get(section_vals, ref_count, n_repetition, n_subs_vals_rep, section, explicit)
returns various attributes about the section_vals
Definition input_section_types.F:704
input_val_types
a wrapper for basic fortran types.
Definition input_val_types.F:14
input_val_types::val_get
subroutine, public val_get(val, has_l, has_i, has_r, has_lc, has_c, l_val, l_vals, i_val, i_vals, r_val, r_vals, c_val, c_vals, len_c, type_of_var, enum)
returns the stored values
Definition input_val_types.F:334
kinds
Defines the basic variable types.
Definition kinds.F:23
kinds::dp
integer, parameter, public dp
Definition kinds.F:34
kinds::default_string_length
integer, parameter, public default_string_length
Definition kinds.F:57
kinds::default_path_length
integer, parameter, public default_path_length
Definition kinds.F:58
list
An array-based list which grows on demand. When the internal array is full, a new array of twice the ...
Definition list.F:24
mathconstants
Definition of mathematical constants and functions.
Definition mathconstants.F:16
mathconstants::pi
real(kind=dp), parameter, public pi
Definition mathconstants.F:110
mathconstants::dfac
real(kind=dp), dimension(-1:2 *maxfac+1), parameter, public dfac
Definition mathconstants.F:61
mathconstants::rootpi
real(kind=dp), parameter, public rootpi
Definition mathconstants.F:114
mathconstants::fac
real(kind=dp), dimension(0:maxfac), parameter, public fac
Definition mathconstants.F:37
mathlib
Collection of simple mathematical functions and subroutines.
Definition mathlib.F:15
mathlib::symmetrize_matrix
subroutine, public symmetrize_matrix(a, option)
Symmetrize the matrix a.
Definition mathlib.F:1197
memory_utilities
Utility routines for the memory handling.
Definition memory_utilities.F:14
message_passing
Interface to the message passing library MPI.
Definition message_passing.F:23
orbital_pointers
Provides Cartesian and spherical orbital pointers and indices.
Definition orbital_pointers.F:15
orbital_pointers::init_orbital_pointers
subroutine, public init_orbital_pointers(maxl)
Initialize or update the orbital pointers.
Definition orbital_pointers.F:253
orbital_pointers::co
integer, dimension(:, :, :), allocatable, public co
Definition orbital_pointers.F:45
orbital_pointers::nco
integer, dimension(:), allocatable, public nco
Definition orbital_pointers.F:42
orbital_pointers::ncoset
integer, dimension(:), allocatable, public ncoset
Definition orbital_pointers.F:42
orbital_pointers::coset
integer, dimension(:, :, :), allocatable, public coset
Definition orbital_pointers.F:45
orbital_pointers::nso
integer, dimension(:), allocatable, public nso
Definition orbital_pointers.F:42
orbital_transformation_matrices
Calculation of the spherical harmonics and the corresponding orbital transformation matrices.
Definition orbital_transformation_matrices.F:17
orbital_transformation_matrices::orbtramat
type(orbtramat_type), dimension(:), pointer, public orbtramat
Definition orbital_transformation_matrices.F:47
periodic_table
Periodic Table related data definitions.
Definition periodic_table.F:28
periodic_table::ptable
type(atom), dimension(0:nelem), public ptable
Definition periodic_table.F:65
string_utilities
Utilities for string manipulations.
Definition string_utilities.F:16
string_utilities::newline
character(len=1), parameter, public newline
Definition string_utilities.F:29
string_utilities::remove_word
subroutine, public remove_word(string)
remove a word from a string (words are separated by white spaces)
Definition string_utilities.F:3275
string_utilities::uppercase
elemental subroutine, public uppercase(string)
Convert all lower case characters in a string to upper case.
Definition string_utilities.F:3362
cp_linked_list_input::cp_sll_val_type
represent a single linked list that stores pointers to the elements
Definition cp_linked_list_input.F:341
cp_parser_types::cp_parser_type
represent a parser
Definition cp_parser_types.F:77
external_potential_types::all_potential_type
Definition external_potential_types.F:70
external_potential_types::fist_potential_type
Definition external_potential_types.F:85
external_potential_types::gth_potential_p_type
Definition external_potential_types.F:227
external_potential_types::gth_potential_type
Definition external_potential_types.F:116
external_potential_types::local_potential_type
Definition external_potential_types.F:98
external_potential_types::sgp_potential_p_type
Definition external_potential_types.F:235
external_potential_types::sgp_potential_type
Definition external_potential_types.F:172
input_section_types::section_vals_type
stores the values of a section
Definition input_section_types.F:127
input_val_types::val_type
a type to have a wrapper that stores any basic fortran type
Definition input_val_types.F:63
message_passing::mp_para_env_type
stores all the informations relevant to an mpi environment
Definition message_passing.F:763