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