(git:374b731)
Loading...
Searching...
No Matches
atom_upf.F
Go to the documentation of this file.
1!--------------------------------------------------------------------------------------------------!
2! CP2K: A general program to perform molecular dynamics simulations !
3! Copyright 2000-2024 CP2K developers group <https://cp2k.org> !
4! !
5! SPDX-License-Identifier: GPL-2.0-or-later !
6!--------------------------------------------------------------------------------------------------!
7
8! **************************************************************************************************
9!> \brief Routines that process Quantum Espresso UPF files.
10!> \par History
11!> * 07.2018 CP2K-SIRIUS interface [Juerg Hutter]
12!> * 02.2016 created [Juerg Hutter]
13! **************************************************************************************************
14MODULE atom_upf
15 USE cp_parser_methods, ONLY: parser_get_next_line,&
16 parser_get_object,&
17 parser_test_next_token
18 USE cp_parser_types, ONLY: cp_parser_type,&
19 parser_create,&
20 parser_release
21 USE kinds, ONLY: default_string_length,&
22 dp
23 USE periodic_table, ONLY: get_ptable_info,&
24 ptable
25#include "./base/base_uses.f90"
26
27 IMPLICIT NONE
28
29 ! use same value as in atom_types!
30 INTEGER, PARAMETER :: lmat = 3
31
32 TYPE atom_upfpot_type
33 CHARACTER(LEN=2) :: symbol = ""
34 CHARACTER(LEN=default_string_length) :: pname = ""
35 INTEGER, DIMENSION(0:lmat) :: econf = 0
36 REAL(dp) :: zion = 0.0_dp
37 CHARACTER(LEN=default_string_length) :: version = ""
38 CHARACTER(LEN=default_string_length) :: filename = ""
39 ! <INFO>
40 INTEGER :: maxinfo = 100
41 CHARACTER(LEN=default_string_length), DIMENSION(100) &
42 :: info = ""
43 ! <HEADER>
44 CHARACTER(LEN=default_string_length) :: generated = ""
45 CHARACTER(LEN=default_string_length) :: author = ""
46 CHARACTER(LEN=default_string_length) :: date = ""
47 CHARACTER(LEN=default_string_length) :: comment = ""
48 CHARACTER(LEN=4) :: pseudo_type = ""
49 CHARACTER(LEN=15) :: relativistic = ""
50 CHARACTER(LEN=default_string_length) :: functional = ""
51 LOGICAL :: is_ultrasoft = .false.
52 LOGICAL :: is_paw = .false.
53 LOGICAL :: is_coulomb = .false.
54 LOGICAL :: has_so = .false.
55 LOGICAL :: has_wfc = .false.
56 LOGICAL :: has_gipaw = .false.
57 LOGICAL :: paw_as_gipaw = .false.
58 LOGICAL :: core_correction = .false.
59 REAL(dp) :: total_psenergy = 0.0_dp
60 REAL(dp) :: wfc_cutoff = 0.0_dp
61 REAL(dp) :: rho_cutoff = 0.0_dp
62 INTEGER :: l_max = -100
63 INTEGER :: l_max_rho = -1
64 INTEGER :: l_local = -1
65 INTEGER :: mesh_size = -1
66 INTEGER :: number_of_wfc = -1
67 INTEGER :: number_of_proj = -1
68 ! <MESH>
69 REAL(dp) :: dx = 0.0_dp
70 REAL(dp) :: xmin = 0.0_dp
71 REAL(dp) :: rmax = 0.0_dp
72 REAL(dp) :: zmesh = 0.0_dp
73 REAL(dp), DIMENSION(:), ALLOCATABLE :: r, rab
74 ! <NLCC>
75 REAL(dp), DIMENSION(:), ALLOCATABLE :: rho_nlcc
76 ! <LOCAL>
77 REAL(dp), DIMENSION(:), ALLOCATABLE :: vlocal
78 ! <NONLOCAL>
79 REAL(dp), DIMENSION(:, :), ALLOCATABLE :: dion
80 REAL(dp), DIMENSION(:, :), ALLOCATABLE :: beta
81 INTEGER, DIMENSION(:), ALLOCATABLE :: lbeta
82 ! <SEMILOCAL>
83 REAL(dp), DIMENSION(:, :), ALLOCATABLE :: vsemi
84 END TYPE atom_upfpot_type
85
86 PRIVATE
87 PUBLIC :: atom_read_upf, atom_upfpot_type, atom_release_upf
88
89 CHARACTER(len=*), PARAMETER, PRIVATE :: modulen = 'atom_upf'
90
91! **************************************************************************************************
92
93CONTAINS
94
95! **************************************************************************************************
96!> \brief ...
97!> \param pot ...
98!> \param upf_filename ...
99!> \param read_header ...
100! **************************************************************************************************
101 SUBROUTINE atom_read_upf(pot, upf_filename, read_header)
102
103 TYPE(atom_upfpot_type) :: pot
104 CHARACTER(len=*), INTENT(IN) :: upf_filename
105 LOGICAL, INTENT(IN), OPTIONAL :: read_header
106
107 CHARACTER(LEN=2) :: symbol
108 INTEGER :: l, ncore, nel
109 LOGICAL :: readall
110
111 IF (PRESENT(read_header)) THEN
112 readall = .NOT. read_header
113 ELSE
114 readall = .true.
115 END IF
116
117 ! filename
118 pot%filename = adjustl(trim(upf_filename))
119
120 ! Ignore json potentials as SIRIUS will parse those on its own.
121 l = len_trim(pot%filename)
122 IF (pot%filename(l - 4:l) == '.json') THEN
123 pot%zion = 0.0
124 RETURN
125 END IF
126
127 CALL atom_read_upf_v2(pot, upf_filename, readall)
128
129 ! set up econf
130 IF (sum(pot%econf) == 0) THEN
131 symbol = adjustl(trim(pot%symbol))
132 CALL get_ptable_info(symbol, number=ncore)
133 pot%econf(0:3) = ptable(ncore)%e_conv(0:3)
134 nel = nint(ncore - pot%zion)
135 SELECT CASE (nel)
136 CASE DEFAULT
137 cpabort("Unknown Core State")
138 CASE (0)
139 ! no core electron
140 CASE (2)
141 pot%econf(0:3) = pot%econf(0:3) - ptable(2)%e_conv(0:3)
142 CASE (10)
143 pot%econf(0:3) = pot%econf(0:3) - ptable(10)%e_conv(0:3)
144 CASE (18)
145 pot%econf(0:3) = pot%econf(0:3) - ptable(18)%e_conv(0:3)
146 CASE (28)
147 pot%econf(0:3) = pot%econf(0:3) - ptable(18)%e_conv(0:3)
148 pot%econf(2) = pot%econf(2) - 10
149 CASE (36)
150 pot%econf(0:3) = pot%econf(0:3) - ptable(36)%e_conv(0:3)
151 CASE (46)
152 pot%econf(0:3) = pot%econf(0:3) - ptable(36)%e_conv(0:3)
153 pot%econf(2) = pot%econf(2) - 10
154 CASE (54)
155 pot%econf(0:3) = pot%econf(0:3) - ptable(54)%e_conv(0:3)
156 CASE (60)
157 pot%econf(0:3) = pot%econf(0:3) - ptable(36)%e_conv(0:3)
158 pot%econf(2) = pot%econf(2) - 10
159 pot%econf(3) = pot%econf(3) - 14
160 CASE (68)
161 pot%econf(0:3) = pot%econf(0:3) - ptable(54)%e_conv(0:3)
162 pot%econf(3) = pot%econf(3) - 14
163 CASE (78)
164 pot%econf(0:3) = pot%econf(0:3) - ptable(54)%e_conv(0:3)
165 pot%econf(2) = pot%econf(2) - 10
166 pot%econf(3) = pot%econf(3) - 14
167 END SELECT
168 !
169 cpassert(all(pot%econf >= 0))
170 END IF
171
172 ! name
173 IF (pot%pname == "") THEN
174 pot%pname = adjustl(trim(pot%symbol))
175 END IF
176
177 END SUBROUTINE atom_read_upf
178
179! **************************************************************************************************
180!> \brief ...
181!> \param pot ...
182!> \param upf_filename ...
183!> \param readall ...
184! **************************************************************************************************
185 SUBROUTINE atom_read_upf_v2(pot, upf_filename, readall)
186
187 TYPE(atom_upfpot_type) :: pot
188 CHARACTER(len=*), INTENT(IN) :: upf_filename
189 LOGICAL, INTENT(IN) :: readall
190
191 CHARACTER(LEN=default_string_length) :: nametag
192 INTEGER :: ib, ntag
193 LOGICAL :: at_end
194 TYPE(cp_parser_type) :: parser
195
196 ntag = 0
197 CALL parser_create(parser, upf_filename)
198 DO
199 at_end = .false.
200 CALL parser_get_next_line(parser, 1, at_end)
201 IF (at_end) EXIT
202 CALL parser_get_object(parser, nametag, lower_to_upper=.true.)
203 IF (nametag(1:1) /= "<") cycle
204 IF (ntag == 0) THEN
205 ! we are looking for UPF tag
206 IF (nametag(2:4) == "UPF") THEN
207 CALL parser_get_object(parser, nametag, lower_to_upper=.true.)
208 ! read UPF file version
209 CALL parser_get_object(parser, nametag, lower_to_upper=.true.)
210 pot%version = trim(nametag)
211 cpassert(nametag(1:5) == "2.0.1")
212 CALL parser_get_object(parser, nametag, lower_to_upper=.true.)
213 cpassert(nametag(1:1) == ">")
214 ntag = 1
215 END IF
216 ELSE IF (ntag == 1) THEN
217 ! we are looking for 1st level tags
218 IF (nametag(2:8) == "PP_INFO") THEN
219 cpassert(nametag(9:9) == ">")
220 CALL upf_info_section(parser, pot)
221 ELSEIF (nametag(2:10) == "PP_HEADER") THEN
222 IF (.NOT. (nametag(11:11) == ">")) THEN
223 CALL upf_header_option(parser, pot)
224 END IF
225 ELSEIF (nametag(2:8) == "PP_MESH") THEN
226 IF (.NOT. (nametag(9:9) == ">")) THEN
227 CALL upf_mesh_option(parser, pot)
228 END IF
229 CALL upf_mesh_section(parser, pot)
230 ELSEIF (nametag(2:8) == "PP_NLCC") THEN
231 IF (nametag(9:9) == ">") THEN
232 CALL upf_nlcc_section(parser, pot, .false.)
233 ELSE
234 CALL upf_nlcc_section(parser, pot, .true.)
235 END IF
236 ELSEIF (nametag(2:9) == "PP_LOCAL") THEN
237 IF (nametag(10:10) == ">") THEN
238 CALL upf_local_section(parser, pot, .false.)
239 ELSE
240 CALL upf_local_section(parser, pot, .true.)
241 END IF
242 ELSEIF (nametag(2:12) == "PP_NONLOCAL") THEN
243 cpassert(nametag(13:13) == ">")
244 CALL upf_nonlocal_section(parser, pot)
245 ELSEIF (nametag(2:13) == "PP_SEMILOCAL") THEN
246 CALL upf_semilocal_section(parser, pot)
247 ELSEIF (nametag(2:9) == "PP_PSWFC") THEN
248 ! skip section for now
249 ELSEIF (nametag(2:11) == "PP_RHOATOM") THEN
250 ! skip section for now
251 ELSEIF (nametag(2:7) == "PP_PAW") THEN
252 ! skip section for now
253 ELSEIF (nametag(2:6) == "/UPF>") THEN
254 EXIT
255 END IF
256 END IF
257 END DO
258 CALL parser_release(parser)
259
260 cpassert(ntag > 0)
261
262 ! rescale projectors
263 IF (ALLOCATED(pot%beta)) THEN
264 DO ib = 1, pot%number_of_proj
265 IF (pot%r(1) == 0.0_dp) THEN
266 pot%beta(2:, ib) = pot%beta(2:, ib)/pot%r(2:)
267 ELSE
268 pot%beta(:, ib) = pot%beta(:, ib)/pot%r(:)
269 END IF
270 END DO
271 END IF
272
273 ! test for not supported options
274 IF (readall) THEN
275 IF (pot%is_ultrasoft) THEN
276 cpabort("UPF ultrasoft pseudopotential not implemented")
277 END IF
278 IF (pot%is_paw) THEN
279 cpabort("UPF PAW potential not implemented")
280 END IF
281 END IF
282
283 END SUBROUTINE atom_read_upf_v2
284
285! **************************************************************************************************
286!> \brief ...
287!> \param parser ...
288!> \param pot ...
289! **************************************************************************************************
290 SUBROUTINE upf_info_section(parser, pot)
291 TYPE(cp_parser_type), INTENT(INOUT) :: parser
292 TYPE(atom_upfpot_type) :: pot
293
294 CHARACTER(LEN=default_string_length) :: line, string
295 INTEGER :: icount, iline
296 LOGICAL :: at_end
297
298 icount = 0
299 DO
300 CALL parser_get_next_line(parser, 1, at_end)
301 cpassert(.NOT. at_end)
302 iline = parser%buffer%present_line_number
303 line = trim(parser%buffer%input_lines(iline))
304 CALL parser_get_object(parser, string)
305 IF (string(1:10) == "</PP_INFO>") EXIT
306 icount = icount + 1
307 IF (icount > pot%maxinfo) cycle
308 pot%info(icount) = line
309 END DO
310 pot%maxinfo = icount
311
312 END SUBROUTINE upf_info_section
313
314! **************************************************************************************************
315!> \brief ...
316!> \param parser ...
317!> \param pot ...
318! **************************************************************************************************
319 SUBROUTINE upf_header_option(parser, pot)
320 TYPE(cp_parser_type), INTENT(INOUT) :: parser
321 TYPE(atom_upfpot_type) :: pot
322
323 CHARACTER(LEN=default_string_length) :: string
324 LOGICAL :: at_end
325
326 DO
327 IF (parser_test_next_token(parser) == "EOL") THEN
328 CALL parser_get_next_line(parser, 1, at_end)
329 cpassert(.NOT. at_end)
330 END IF
331 CALL parser_get_object(parser, string, lower_to_upper=.true.)
332 IF (string == "/>") EXIT
333 SELECT CASE (string)
334 CASE ("GENERATED")
335 CALL parser_get_object(parser, pot%generated)
336 CASE ("AUTHOR")
337 CALL parser_get_object(parser, pot%author)
338 CASE ("DATE")
339 CALL parser_get_object(parser, pot%date)
340 CASE ("COMMENT")
341 CALL parser_get_object(parser, pot%comment)
342 CASE ("ELEMENT")
343 CALL parser_get_object(parser, pot%symbol)
344 cpassert(2 <= len(pot%symbol))
345 CASE ("PSEUDO_TYPE")
346 CALL parser_get_object(parser, pot%pseudo_type)
347 CASE ("RELATIVISTIC")
348 CALL parser_get_object(parser, pot%relativistic)
349 CASE ("IS_ULTRASOFT")
350 CALL parser_get_object(parser, pot%is_ultrasoft)
351 CASE ("IS_PAW")
352 CALL parser_get_object(parser, pot%is_paw)
353 CASE ("IS_COULOMB")
354 CALL parser_get_object(parser, pot%is_coulomb)
355 CASE ("HAS_SO")
356 CALL parser_get_object(parser, pot%has_so)
357 CASE ("HAS_WFC")
358 CALL parser_get_object(parser, pot%has_wfc)
359 CASE ("HAS_GIPAW")
360 CALL parser_get_object(parser, pot%has_gipaw)
361 CASE ("PAW_AS_GIPAW")
362 CALL parser_get_object(parser, pot%paw_as_gipaw)
363 CASE ("CORE_CORRECTION")
364 CALL parser_get_object(parser, pot%core_correction)
365 CASE ("FUNCTIONAL")
366 CALL parser_get_object(parser, pot%functional)
367 CASE ("Z_VALENCE")
368 CALL parser_get_object(parser, pot%zion)
369 CASE ("TOTAL_PSENERGY")
370 CALL parser_get_object(parser, pot%total_psenergy)
371 CASE ("WFC_CUTOFF")
372 CALL parser_get_object(parser, pot%wfc_cutoff)
373 CASE ("RHO_CUTOFF")
374 CALL parser_get_object(parser, pot%rho_cutoff)
375 CASE ("L_MAX")
376 CALL parser_get_object(parser, pot%l_max)
377 CASE ("L_MAX_RHO")
378 CALL parser_get_object(parser, pot%l_max_rho)
379 CASE ("L_LOCAL")
380 CALL parser_get_object(parser, pot%l_local)
381 CASE ("MESH_SIZE")
382 CALL parser_get_object(parser, pot%mesh_size)
383 CASE ("NUMBER_OF_WFC")
384 CALL parser_get_object(parser, pot%number_of_wfc)
385 CASE ("NUMBER_OF_PROJ")
386 CALL parser_get_object(parser, pot%number_of_proj)
387 CASE DEFAULT
388 cpwarn(string)
389 CALL cp_abort(__location__, "Error while parsing UPF header: "// &
390 "Adjust format of delimiters ... only double quotes are admissible.")
391 END SELECT
392 END DO
393
394 END SUBROUTINE upf_header_option
395
396! **************************************************************************************************
397!> \brief ...
398!> \param parser ...
399!> \param pot ...
400! **************************************************************************************************
401 SUBROUTINE upf_mesh_option(parser, pot)
402 TYPE(cp_parser_type), INTENT(INOUT) :: parser
403 TYPE(atom_upfpot_type) :: pot
404
405 CHARACTER(LEN=default_string_length) :: string
406 INTEGER :: jj
407 LOGICAL :: at_end
408
409 DO
410 IF (parser_test_next_token(parser) == "EOL") THEN
411 CALL parser_get_next_line(parser, 1, at_end)
412 cpassert(.NOT. at_end)
413 END IF
414 CALL parser_get_object(parser, string, lower_to_upper=.true.)
415 IF (string == ">") EXIT
416 SELECT CASE (string)
417 CASE ("DX")
418 CALL parser_get_object(parser, pot%dx)
419 CASE ("XMIN")
420 CALL parser_get_object(parser, pot%xmin)
421 CASE ("RMAX")
422 CALL parser_get_object(parser, pot%rmax)
423 CASE ("MESH")
424 CALL parser_get_object(parser, jj)
425 cpassert(pot%mesh_size == jj)
426 CASE ("ZMESH")
427 CALL parser_get_object(parser, pot%zmesh)
428 CASE DEFAULT
429 cpabort("Unknown UPF PP_MESH option <"//trim(string)//"> found")
430 END SELECT
431
432 END DO
433
434 END SUBROUTINE upf_mesh_option
435
436! **************************************************************************************************
437!> \brief ...
438!> \param parser ...
439!> \param pot ...
440! **************************************************************************************************
441 SUBROUTINE upf_mesh_section(parser, pot)
442 TYPE(cp_parser_type), INTENT(INOUT) :: parser
443 TYPE(atom_upfpot_type) :: pot
444
445 CHARACTER(LEN=default_string_length) :: line, string, string2
446 INTEGER :: icount, m, mc, ms
447 LOGICAL :: at_end
448
449 DO
450 CALL parser_get_next_line(parser, 1, at_end)
451 cpassert(.NOT. at_end)
452 CALL parser_get_object(parser, string, lower_to_upper=.true.)
453 SELECT CASE (string)
454 CASE ("<PP_R")
455 m = pot%mesh_size
456 ms = pot%mesh_size
457 mc = 1
458 IF (string(6:6) /= ">") THEN
459 ! options
460 DO
461 IF (parser_test_next_token(parser) == "EOL") THEN
462 CALL parser_get_next_line(parser, 1, at_end)
463 cpassert(.NOT. at_end)
464 END IF
465 CALL parser_get_object(parser, string2, lower_to_upper=.true.)
466 IF (string2 == ">") EXIT
467 SELECT CASE (string2)
468 CASE ("TYPE")
469 CALL parser_get_object(parser, line, lower_to_upper=.true.)
470 cpassert(line == "REAL")
471 CASE ("SIZE")
472 CALL parser_get_object(parser, ms)
473 cpassert(ms <= m)
474 CASE ("COLUMNS")
475 CALL parser_get_object(parser, mc)
476 CASE DEFAULT
477 cpabort("Unknown UPF PP_R option <"//trim(string2)//"> found")
478 END SELECT
479 END DO
480 END IF
481 ALLOCATE (pot%r(m))
482 pot%r = 0.0_dp
483 icount = 1
484 DO
485 IF (parser_test_next_token(parser) == "EOL") THEN
486 CALL parser_get_next_line(parser, 1, at_end)
487 cpassert(.NOT. at_end)
488 ELSE IF (parser_test_next_token(parser) == "FLT") THEN
489 CALL parser_get_object(parser, pot%r(icount))
490 icount = icount + 1
491 END IF
492 IF (icount > ms) EXIT
493 END DO
494 CASE ("<PP_RAB")
495 IF (string(6:6) /= ">") THEN
496 ! options
497 DO
498 IF (parser_test_next_token(parser) == "EOL") THEN
499 CALL parser_get_next_line(parser, 1, at_end)
500 cpassert(.NOT. at_end)
501 END IF
502 CALL parser_get_object(parser, string2, lower_to_upper=.true.)
503 IF (string2 == ">") EXIT
504 SELECT CASE (string2)
505 CASE ("TYPE")
506 CALL parser_get_object(parser, line, lower_to_upper=.true.)
507 cpassert(line == "REAL")
508 CASE ("SIZE")
509 CALL parser_get_object(parser, ms)
510 cpassert(ms <= m)
511 CASE ("COLUMNS")
512 CALL parser_get_object(parser, mc)
513 CASE DEFAULT
514 cpabort("Unknown UPF PP_RAB option <"//trim(string2)//"> found")
515 END SELECT
516 END DO
517 END IF
518 ALLOCATE (pot%rab(m))
519 pot%rab = 0.0_dp
520 icount = 1
521 DO
522 IF (parser_test_next_token(parser) == "EOL") THEN
523 CALL parser_get_next_line(parser, 1, at_end)
524 cpassert(.NOT. at_end)
525 ELSE IF (parser_test_next_token(parser) == "FLT") THEN
526 CALL parser_get_object(parser, pot%rab(icount))
527 icount = icount + 1
528 END IF
529 IF (icount > ms) EXIT
530 END DO
531 CASE ("</PP_MESH>")
532 EXIT
533 CASE DEFAULT
534 !
535 END SELECT
536 END DO
537
538 END SUBROUTINE upf_mesh_section
539
540! **************************************************************************************************
541!> \brief ...
542!> \param parser ...
543!> \param pot ...
544!> \param options ...
545! **************************************************************************************************
546 SUBROUTINE upf_nlcc_section(parser, pot, options)
547 TYPE(cp_parser_type), INTENT(INOUT) :: parser
548 TYPE(atom_upfpot_type) :: pot
549 LOGICAL, INTENT(IN) :: options
550
551 CHARACTER(LEN=default_string_length) :: line, string
552 INTEGER :: icount, m, mc, ms
553 LOGICAL :: at_end
554
555 m = pot%mesh_size
556 ms = m
557 mc = 1
558 IF (options) THEN
559 DO
560 IF (parser_test_next_token(parser) == "EOL") THEN
561 CALL parser_get_next_line(parser, 1, at_end)
562 cpassert(.NOT. at_end)
563 END IF
564 CALL parser_get_object(parser, string, lower_to_upper=.true.)
565 IF (string == ">") EXIT
566 SELECT CASE (string)
567 CASE ("TYPE")
568 CALL parser_get_object(parser, line, lower_to_upper=.true.)
569 cpassert(line == "REAL")
570 CASE ("SIZE")
571 CALL parser_get_object(parser, ms)
572 cpassert(ms <= m)
573 CASE ("COLUMNS")
574 CALL parser_get_object(parser, mc)
575 CASE DEFAULT
576 cpabort("Unknown UPF PP_NLCC option <"//trim(string)//"> found")
577 END SELECT
578 END DO
579 END IF
580
581 ALLOCATE (pot%rho_nlcc(m))
582 pot%rho_nlcc = 0.0_dp
583 icount = 1
584 DO
585 IF (parser_test_next_token(parser) == "EOL") THEN
586 CALL parser_get_next_line(parser, 1, at_end)
587 cpassert(.NOT. at_end)
588 ELSE IF (parser_test_next_token(parser) == "FLT") THEN
589 CALL parser_get_object(parser, pot%rho_nlcc(icount))
590 icount = icount + 1
591 END IF
592 IF (icount > ms) EXIT
593 END DO
594
595 CALL parser_get_next_line(parser, 1, at_end)
596 cpassert(.NOT. at_end)
597 CALL parser_get_object(parser, string, lower_to_upper=.true.)
598 cpassert(string == "</PP_NLCC>")
599
600 END SUBROUTINE upf_nlcc_section
601
602! **************************************************************************************************
603!> \brief ...
604!> \param parser ...
605!> \param pot ...
606!> \param options ...
607! **************************************************************************************************
608 SUBROUTINE upf_local_section(parser, pot, options)
609 TYPE(cp_parser_type), INTENT(INOUT) :: parser
610 TYPE(atom_upfpot_type) :: pot
611 LOGICAL, INTENT(IN) :: options
612
613 CHARACTER(LEN=default_string_length) :: line, string
614 INTEGER :: icount, m, mc, ms
615 LOGICAL :: at_end
616
617 m = pot%mesh_size
618 ms = m
619 mc = 1
620 IF (options) THEN
621 DO
622 IF (parser_test_next_token(parser) == "EOL") THEN
623 CALL parser_get_next_line(parser, 1, at_end)
624 cpassert(.NOT. at_end)
625 END IF
626 CALL parser_get_object(parser, string, lower_to_upper=.true.)
627 IF (string == ">") EXIT
628 SELECT CASE (string)
629 CASE ("TYPE")
630 CALL parser_get_object(parser, line, lower_to_upper=.true.)
631 cpassert(line == "REAL")
632 CASE ("SIZE")
633 CALL parser_get_object(parser, ms)
634 cpassert(ms <= m)
635 CASE ("COLUMNS")
636 CALL parser_get_object(parser, mc)
637 CASE DEFAULT
638 cpabort("Unknown UPF PP_LOCAL option <"//trim(string)//"> found")
639 END SELECT
640 END DO
641 END IF
642
643 ALLOCATE (pot%vlocal(m))
644 pot%vlocal = 0.0_dp
645 icount = 1
646 DO
647 IF (parser_test_next_token(parser) == "EOL") THEN
648 CALL parser_get_next_line(parser, 1, at_end)
649 cpassert(.NOT. at_end)
650 ELSE IF (parser_test_next_token(parser) == "FLT") THEN
651 CALL parser_get_object(parser, pot%vlocal(icount))
652 icount = icount + 1
653 END IF
654 IF (icount > ms) EXIT
655 END DO
656
657 ! Ry -> Hartree
658 pot%vlocal = 0.5_dp*pot%vlocal
659
660 CALL parser_get_next_line(parser, 1, at_end)
661 cpassert(.NOT. at_end)
662 CALL parser_get_object(parser, string, lower_to_upper=.true.)
663 cpassert(string == "</PP_LOCAL>")
664
665 END SUBROUTINE upf_local_section
666
667! **************************************************************************************************
668!> \brief ...
669!> \param parser ...
670!> \param pot ...
671! **************************************************************************************************
672 SUBROUTINE upf_nonlocal_section(parser, pot)
673 TYPE(cp_parser_type), INTENT(INOUT) :: parser
674 TYPE(atom_upfpot_type) :: pot
675
676 CHARACTER(LEN=default_string_length) :: line, string
677 INTEGER :: i1, i2, ibeta, icount, la, m, mc, ms, &
678 nbeta
679 LOGICAL :: at_end
680
681 m = pot%mesh_size
682 nbeta = pot%number_of_proj
683 ALLOCATE (pot%dion(nbeta, nbeta), pot%beta(m, nbeta), pot%lbeta(nbeta))
684 pot%dion = 0.0_dp
685 pot%beta = 0.0_dp
686 pot%lbeta = -1
687
688 ibeta = 0
689 DO
690 CALL parser_get_next_line(parser, 1, at_end)
691 cpassert(.NOT. at_end)
692 CALL parser_get_object(parser, string, lower_to_upper=.true.)
693 IF (string(1:8) == "<PP_BETA") THEN
694 ms = m
695 ibeta = ibeta + 1
696 i1 = ibeta
697 la = 0
698 cpassert(ibeta <= nbeta)
699 DO
700 IF (parser_test_next_token(parser) == "EOL") THEN
701 CALL parser_get_next_line(parser, 1, at_end)
702 cpassert(.NOT. at_end)
703 END IF
704 CALL parser_get_object(parser, string, lower_to_upper=.true.)
705 IF (string == ">") EXIT
706 SELECT CASE (string)
707 CASE ("TYPE")
708 CALL parser_get_object(parser, line, lower_to_upper=.true.)
709 cpassert(line == "REAL")
710 CASE ("SIZE")
711 CALL parser_get_object(parser, ms)
712 cpassert(ms <= m)
713 CASE ("COLUMNS")
714 CALL parser_get_object(parser, mc)
715 CASE ("INDEX")
716 CALL parser_get_object(parser, i1)
717 cpassert(i1 <= nbeta)
718 CASE ("ANGULAR_MOMENTUM")
719 CALL parser_get_object(parser, la)
720 CASE ("LABEL")
721 CALL parser_get_object(parser, line)
722 ! not used currently
723 CASE ("CUTOFF_RADIUS_INDEX")
724 CALL parser_get_object(parser, line)
725 ! not used currently
726 CASE ("CUTOFF_RADIUS")
727 CALL parser_get_object(parser, line)
728 ! not used currently
729 CASE ("ULTRASOFT_CUTOFF_RADIUS")
730 CALL parser_get_object(parser, line)
731 ! not used currently
732 CASE DEFAULT
733 cpabort("Unknown UPF PP_BETA option <"//trim(string)//"> found")
734 END SELECT
735 END DO
736 pot%lbeta(i1) = la
737 icount = 1
738 DO
739 IF (parser_test_next_token(parser) == "EOL") THEN
740 CALL parser_get_next_line(parser, 1, at_end)
741 cpassert(.NOT. at_end)
742 ELSE IF (parser_test_next_token(parser) == "FLT") THEN
743 CALL parser_get_object(parser, pot%beta(icount, i1))
744 icount = icount + 1
745 END IF
746 IF (icount > ms) EXIT
747 END DO
748 ELSE IF (string(1:7) == "<PP_DIJ") THEN
749 ms = nbeta*nbeta
750 DO
751 IF (parser_test_next_token(parser) == "EOL") THEN
752 CALL parser_get_next_line(parser, 1, at_end)
753 cpassert(.NOT. at_end)
754 END IF
755 CALL parser_get_object(parser, string, lower_to_upper=.true.)
756 IF (string == ">") EXIT
757 SELECT CASE (string)
758 CASE ("TYPE")
759 CALL parser_get_object(parser, line, lower_to_upper=.true.)
760 cpassert(line == "REAL")
761 CASE ("SIZE")
762 CALL parser_get_object(parser, ms)
763 cpassert(ms <= m)
764 CASE ("COLUMNS")
765 CALL parser_get_object(parser, mc)
766 CASE DEFAULT
767 cpabort("Unknown UPF PP_DIJ option <"//trim(string)//"> found")
768 END SELECT
769 END DO
770 icount = 1
771 DO
772 IF (parser_test_next_token(parser) == "EOL") THEN
773 CALL parser_get_next_line(parser, 1, at_end)
774 cpassert(.NOT. at_end)
775 ELSE IF (parser_test_next_token(parser) == "FLT") THEN
776 i1 = (icount - 1)/nbeta + 1
777 i2 = mod(icount - 1, nbeta) + 1
778 CALL parser_get_object(parser, pot%dion(i1, i2))
779 icount = icount + 1
780 END IF
781 IF (icount > ms) EXIT
782 END DO
783 ELSE IF (string(1:7) == "<PP_QIJL") THEN
784 ! skip this option
785 ELSE IF (string(1:14) == "</PP_NONLOCAL>") THEN
786 EXIT
787 END IF
788 END DO
789
790 ! change units and scaling, beta is still r*beta
791 pot%dion = 2.0_dp*pot%dion
792 pot%beta = 0.5_dp*pot%beta
793
794 END SUBROUTINE upf_nonlocal_section
795
796! **************************************************************************************************
797!> \brief ...
798!> \param parser ...
799!> \param pot ...
800! **************************************************************************************************
801 SUBROUTINE upf_semilocal_section(parser, pot)
802 TYPE(cp_parser_type), INTENT(INOUT) :: parser
803 TYPE(atom_upfpot_type) :: pot
804
805 CHARACTER(LEN=default_string_length) :: line, string
806 INTEGER :: i1, ib, icount, la, lmax, m, mc, ms
807 LOGICAL :: at_end
808
809 m = pot%mesh_size
810 lmax = pot%l_max
811 ALLOCATE (pot%vsemi(m, lmax + 1))
812 pot%vsemi = 0.0_dp
813
814 ib = 0
815 DO
816 CALL parser_get_next_line(parser, 1, at_end)
817 cpassert(.NOT. at_end)
818 CALL parser_get_object(parser, string, lower_to_upper=.true.)
819 IF (string(1:7) == "<PP_VNL") THEN
820 ms = m
821 ib = ib + 1
822 i1 = ib
823 la = 0
824 cpassert(ib <= lmax + 1)
825 DO
826 IF (parser_test_next_token(parser) == "EOL") THEN
827 CALL parser_get_next_line(parser, 1, at_end)
828 cpassert(.NOT. at_end)
829 END IF
830 CALL parser_get_object(parser, string, lower_to_upper=.true.)
831 IF (string == ">") EXIT
832 SELECT CASE (string)
833 CASE ("TYPE")
834 CALL parser_get_object(parser, line, lower_to_upper=.true.)
835 cpassert(line == "REAL")
836 CASE ("SIZE")
837 CALL parser_get_object(parser, ms)
838 cpassert(ms <= m)
839 CASE ("COLUMNS")
840 CALL parser_get_object(parser, mc)
841 CASE ("L")
842 CALL parser_get_object(parser, la)
843 CASE DEFAULT
844 cpabort("Unknown UPF PP_VNL option <"//trim(string)//"> found")
845 END SELECT
846 END DO
847 i1 = la + 1
848 icount = 1
849 DO
850 IF (parser_test_next_token(parser) == "EOL") THEN
851 CALL parser_get_next_line(parser, 1, at_end)
852 cpassert(.NOT. at_end)
853 ELSE IF (parser_test_next_token(parser) == "FLT") THEN
854 CALL parser_get_object(parser, pot%vsemi(icount, i1))
855 icount = icount + 1
856 END IF
857 IF (icount > ms) EXIT
858 END DO
859 ELSEIF (string(1:15) == "</PP_SEMILOCAL>") THEN
860 EXIT
861 ELSE
862 !
863 END IF
864 END DO
865 ! Ry -> Hartree
866 pot%vsemi = 0.5_dp*pot%vsemi
867
868 END SUBROUTINE upf_semilocal_section
869
870! **************************************************************************************************
871!> \brief ...
872!> \param upfpot ...
873! **************************************************************************************************
874 PURE SUBROUTINE atom_release_upf(upfpot)
875
876 TYPE(atom_upfpot_type), INTENT(INOUT) :: upfpot
877
878 IF (ALLOCATED(upfpot%r)) DEALLOCATE (upfpot%r)
879 IF (ALLOCATED(upfpot%rab)) DEALLOCATE (upfpot%rab)
880 IF (ALLOCATED(upfpot%vlocal)) DEALLOCATE (upfpot%vlocal)
881 IF (ALLOCATED(upfpot%dion)) DEALLOCATE (upfpot%dion)
882 IF (ALLOCATED(upfpot%beta)) DEALLOCATE (upfpot%beta)
883 IF (ALLOCATED(upfpot%lbeta)) DEALLOCATE (upfpot%lbeta)
884 IF (ALLOCATED(upfpot%vsemi)) DEALLOCATE (upfpot%vsemi)
885
886 END SUBROUTINE atom_release_upf
887! **************************************************************************************************
888
889END MODULE atom_upf
cp_parser_methods::parser_get_object
Definition cp_parser_methods.F:54
atom_upf
Routines that process Quantum Espresso UPF files.
Definition atom_upf.F:14
atom_upf::atom_read_upf
subroutine, public atom_read_upf(pot, upf_filename, read_header)
...
Definition atom_upf.F:102
atom_upf::lmat
integer, parameter lmat
Definition atom_upf.F:30
atom_upf::atom_release_upf
pure subroutine, public atom_release_upf(upfpot)
...
Definition atom_upf.F:875
cp_parser_methods
Utility routines to read data from files. Kept as close as possible to the old parser because.
Definition cp_parser_methods.F:20
cp_parser_methods::parser_get_next_line
subroutine, public parser_get_next_line(parser, nline, at_end)
Read the next input line and broadcast the input information. Skip (nline-1) lines and skip also all ...
Definition cp_parser_methods.F:421
cp_parser_methods::parser_test_next_token
character(len=3) function, public parser_test_next_token(parser, string_length)
Test next input object.
Definition cp_parser_methods.F:691
cp_parser_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
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
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
periodic_table::get_ptable_info
subroutine, public get_ptable_info(symbol, number, amass, ielement, covalent_radius, metallic_radius, vdw_radius, found)
Pass information about the kind given the element symbol.
Definition periodic_table.F:85
atom_upf::atom_upfpot_type
Definition atom_upf.F:32
cp_parser_types::cp_parser_type
represent a parser
Definition cp_parser_types.F:77