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