Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2025 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \brief 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 : ! **************************************************************************************************
14 : MODULE 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 :
93 : CONTAINS
94 :
95 : ! **************************************************************************************************
96 : !> \brief ...
97 : !> \param pot ...
98 : !> \param upf_filename ...
99 : !> \param read_header ...
100 : ! **************************************************************************************************
101 16 : 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 16 : IF (PRESENT(read_header)) THEN
112 0 : readall = .NOT. read_header
113 : ELSE
114 16 : readall = .TRUE.
115 : END IF
116 :
117 : ! filename
118 16 : pot%filename = ADJUSTL(TRIM(upf_filename))
119 :
120 : ! Ignore json potentials as SIRIUS will parse those on its own.
121 16 : l = LEN_TRIM(pot%filename)
122 16 : IF (pot%filename(l - 4:l) == '.json') THEN
123 0 : pot%zion = 0.0
124 0 : RETURN
125 : END IF
126 :
127 16 : CALL atom_read_upf_v2(pot, upf_filename, readall)
128 :
129 : ! set up econf
130 80 : IF (SUM(pot%econf) == 0) THEN
131 16 : symbol = ADJUSTL(TRIM(pot%symbol))
132 16 : CALL get_ptable_info(symbol, number=ncore)
133 80 : pot%econf(0:3) = ptable(ncore)%e_conv(0:3)
134 16 : nel = NINT(ncore - pot%zion)
135 0 : SELECT CASE (nel)
136 : CASE DEFAULT
137 0 : CPABORT("Unknown Core State")
138 : CASE (0)
139 : ! no core electron
140 : CASE (2)
141 50 : pot%econf(0:3) = pot%econf(0:3) - ptable(2)%e_conv(0:3)
142 : CASE (10)
143 0 : pot%econf(0:3) = pot%econf(0:3) - ptable(10)%e_conv(0:3)
144 : CASE (18)
145 0 : pot%econf(0:3) = pot%econf(0:3) - ptable(18)%e_conv(0:3)
146 : CASE (28)
147 0 : pot%econf(0:3) = pot%econf(0:3) - ptable(18)%e_conv(0:3)
148 0 : pot%econf(2) = pot%econf(2) - 10
149 : CASE (36)
150 0 : pot%econf(0:3) = pot%econf(0:3) - ptable(36)%e_conv(0:3)
151 : CASE (46)
152 0 : pot%econf(0:3) = pot%econf(0:3) - ptable(36)%e_conv(0:3)
153 0 : pot%econf(2) = pot%econf(2) - 10
154 : CASE (54)
155 0 : pot%econf(0:3) = pot%econf(0:3) - ptable(54)%e_conv(0:3)
156 : CASE (60)
157 0 : pot%econf(0:3) = pot%econf(0:3) - ptable(36)%e_conv(0:3)
158 0 : pot%econf(2) = pot%econf(2) - 10
159 0 : pot%econf(3) = pot%econf(3) - 14
160 : CASE (68)
161 0 : pot%econf(0:3) = pot%econf(0:3) - ptable(54)%e_conv(0:3)
162 0 : pot%econf(3) = pot%econf(3) - 14
163 : CASE (78)
164 0 : pot%econf(0:3) = pot%econf(0:3) - ptable(54)%e_conv(0:3)
165 0 : pot%econf(2) = pot%econf(2) - 10
166 16 : pot%econf(3) = pot%econf(3) - 14
167 : END SELECT
168 : !
169 80 : CPASSERT(ALL(pot%econf >= 0))
170 : END IF
171 :
172 : ! name
173 16 : IF (pot%pname == "") THEN
174 16 : 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 16 : 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 16 : ntag = 0
197 16 : CALL parser_create(parser, upf_filename)
198 : DO
199 : at_end = .FALSE.
200 10788 : CALL parser_get_next_line(parser, 1, at_end)
201 10788 : IF (at_end) EXIT
202 10788 : CALL parser_get_object(parser, nametag, lower_to_upper=.TRUE.)
203 10788 : IF (nametag(1:1) /= "<") CYCLE
204 302 : IF (ntag == 0) THEN
205 : ! we are looking for UPF tag
206 16 : IF (nametag(2:4) == "UPF") THEN
207 16 : CALL parser_get_object(parser, nametag, lower_to_upper=.TRUE.)
208 : ! read UPF file version
209 16 : CALL parser_get_object(parser, nametag, lower_to_upper=.TRUE.)
210 16 : pot%version = TRIM(nametag)
211 16 : CPASSERT(nametag(1:5) == "2.0.1")
212 16 : CALL parser_get_object(parser, nametag, lower_to_upper=.TRUE.)
213 16 : CPASSERT(nametag(1:1) == ">")
214 : ntag = 1
215 : END IF
216 270 : ELSE IF (ntag == 1) THEN
217 : ! we are looking for 1st level tags
218 270 : IF (nametag(2:8) == "PP_INFO") THEN
219 16 : CPASSERT(nametag(9:9) == ">")
220 16 : CALL upf_info_section(parser, pot)
221 254 : ELSEIF (nametag(2:10) == "PP_HEADER") THEN
222 16 : IF (.NOT. (nametag(11:11) == ">")) THEN
223 16 : CALL upf_header_option(parser, pot)
224 : END IF
225 238 : ELSEIF (nametag(2:8) == "PP_MESH") THEN
226 16 : IF (.NOT. (nametag(9:9) == ">")) THEN
227 16 : CALL upf_mesh_option(parser, pot)
228 : END IF
229 16 : CALL upf_mesh_section(parser, pot)
230 222 : ELSEIF (nametag(2:8) == "PP_NLCC") THEN
231 0 : IF (nametag(9:9) == ">") THEN
232 0 : CALL upf_nlcc_section(parser, pot, .FALSE.)
233 : ELSE
234 0 : CALL upf_nlcc_section(parser, pot, .TRUE.)
235 : END IF
236 222 : ELSEIF (nametag(2:9) == "PP_LOCAL") THEN
237 16 : IF (nametag(10:10) == ">") THEN
238 0 : CALL upf_local_section(parser, pot, .FALSE.)
239 : ELSE
240 16 : CALL upf_local_section(parser, pot, .TRUE.)
241 : END IF
242 206 : ELSEIF (nametag(2:12) == "PP_NONLOCAL") THEN
243 16 : CPASSERT(nametag(13:13) == ">")
244 16 : CALL upf_nonlocal_section(parser, pot)
245 190 : ELSEIF (nametag(2:13) == "PP_SEMILOCAL") THEN
246 2 : CALL upf_semilocal_section(parser, pot)
247 188 : ELSEIF (nametag(2:9) == "PP_PSWFC") THEN
248 : ! skip section for now
249 172 : ELSEIF (nametag(2:11) == "PP_RHOATOM") THEN
250 : ! skip section for now
251 156 : ELSEIF (nametag(2:7) == "PP_PAW") THEN
252 : ! skip section for now
253 156 : ELSEIF (nametag(2:6) == "/UPF>") THEN
254 : EXIT
255 : END IF
256 : END IF
257 : END DO
258 16 : CALL parser_release(parser)
259 :
260 16 : CPASSERT(ntag > 0)
261 :
262 : ! rescale projectors
263 16 : IF (ALLOCATED(pot%beta)) THEN
264 30 : DO ib = 1, pot%number_of_proj
265 30 : IF (pot%r(1) == 0.0_dp) THEN
266 0 : pot%beta(2:, ib) = pot%beta(2:, ib)/pot%r(2:)
267 : ELSE
268 11452 : 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 16 : IF (readall) THEN
275 16 : IF (pot%is_ultrasoft) THEN
276 0 : CPABORT("UPF ultrasoft pseudopotential not implemented")
277 : END IF
278 16 : IF (pot%is_paw) THEN
279 0 : CPABORT("UPF PAW potential not implemented")
280 : END IF
281 : END IF
282 :
283 48 : END SUBROUTINE atom_read_upf_v2
284 :
285 : ! **************************************************************************************************
286 : !> \brief ...
287 : !> \param parser ...
288 : !> \param pot ...
289 : ! **************************************************************************************************
290 16 : 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 16 : icount = 0
299 : DO
300 264 : CALL parser_get_next_line(parser, 1, at_end)
301 264 : CPASSERT(.NOT. at_end)
302 264 : iline = parser%buffer%present_line_number
303 264 : line = TRIM(parser%buffer%input_lines(iline))
304 264 : CALL parser_get_object(parser, string)
305 264 : IF (string(1:10) == "</PP_INFO>") EXIT
306 248 : icount = icount + 1
307 248 : IF (icount > pot%maxinfo) CYCLE
308 248 : pot%info(icount) = line
309 : END DO
310 16 : pot%maxinfo = icount
311 :
312 16 : END SUBROUTINE upf_info_section
313 :
314 : ! **************************************************************************************************
315 : !> \brief ...
316 : !> \param parser ...
317 : !> \param pot ...
318 : ! **************************************************************************************************
319 16 : 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 432 : IF (parser_test_next_token(parser) == "EOL") THEN
328 400 : CALL parser_get_next_line(parser, 1, at_end)
329 832 : CPASSERT(.NOT. at_end)
330 : END IF
331 432 : CALL parser_get_object(parser, string, lower_to_upper=.TRUE.)
332 432 : IF (string == "/>") EXIT
333 16 : SELECT CASE (string)
334 : CASE ("GENERATED")
335 16 : CALL parser_get_object(parser, pot%generated)
336 : CASE ("AUTHOR")
337 16 : CALL parser_get_object(parser, pot%author)
338 : CASE ("DATE")
339 16 : CALL parser_get_object(parser, pot%date)
340 : CASE ("COMMENT")
341 16 : CALL parser_get_object(parser, pot%comment)
342 : CASE ("ELEMENT")
343 16 : CALL parser_get_object(parser, pot%symbol)
344 16 : CPASSERT(2 <= LEN(pot%symbol))
345 : CASE ("PSEUDO_TYPE")
346 16 : CALL parser_get_object(parser, pot%pseudo_type)
347 : CASE ("RELATIVISTIC")
348 16 : CALL parser_get_object(parser, pot%relativistic)
349 : CASE ("IS_ULTRASOFT")
350 16 : CALL parser_get_object(parser, pot%is_ultrasoft)
351 : CASE ("IS_PAW")
352 16 : CALL parser_get_object(parser, pot%is_paw)
353 : CASE ("IS_COULOMB")
354 16 : CALL parser_get_object(parser, pot%is_coulomb)
355 : CASE ("HAS_SO")
356 16 : CALL parser_get_object(parser, pot%has_so)
357 : CASE ("HAS_WFC")
358 16 : CALL parser_get_object(parser, pot%has_wfc)
359 : CASE ("HAS_GIPAW")
360 16 : CALL parser_get_object(parser, pot%has_gipaw)
361 : CASE ("PAW_AS_GIPAW")
362 16 : CALL parser_get_object(parser, pot%paw_as_gipaw)
363 : CASE ("CORE_CORRECTION")
364 16 : CALL parser_get_object(parser, pot%core_correction)
365 : CASE ("FUNCTIONAL")
366 16 : CALL parser_get_object(parser, pot%functional)
367 : CASE ("Z_VALENCE")
368 16 : CALL parser_get_object(parser, pot%zion)
369 : CASE ("TOTAL_PSENERGY")
370 16 : CALL parser_get_object(parser, pot%total_psenergy)
371 : CASE ("WFC_CUTOFF")
372 16 : CALL parser_get_object(parser, pot%wfc_cutoff)
373 : CASE ("RHO_CUTOFF")
374 16 : CALL parser_get_object(parser, pot%rho_cutoff)
375 : CASE ("L_MAX")
376 16 : CALL parser_get_object(parser, pot%l_max)
377 : CASE ("L_MAX_RHO")
378 16 : CALL parser_get_object(parser, pot%l_max_rho)
379 : CASE ("L_LOCAL")
380 16 : CALL parser_get_object(parser, pot%l_local)
381 : CASE ("MESH_SIZE")
382 16 : CALL parser_get_object(parser, pot%mesh_size)
383 : CASE ("NUMBER_OF_WFC")
384 16 : CALL parser_get_object(parser, pot%number_of_wfc)
385 : CASE ("NUMBER_OF_PROJ")
386 16 : CALL parser_get_object(parser, pot%number_of_proj)
387 : CASE DEFAULT
388 0 : CPWARN(string)
389 : CALL cp_abort(__LOCATION__, "Error while parsing UPF header: "// &
390 416 : "Adjust format of delimiters ... only double quotes are admissible.")
391 : END SELECT
392 : END DO
393 :
394 16 : END SUBROUTINE upf_header_option
395 :
396 : ! **************************************************************************************************
397 : !> \brief ...
398 : !> \param parser ...
399 : !> \param pot ...
400 : ! **************************************************************************************************
401 16 : 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 96 : IF (parser_test_next_token(parser) == "EOL") THEN
411 16 : CALL parser_get_next_line(parser, 1, at_end)
412 112 : CPASSERT(.NOT. at_end)
413 : END IF
414 96 : CALL parser_get_object(parser, string, lower_to_upper=.TRUE.)
415 96 : IF (string == ">") EXIT
416 16 : SELECT CASE (string)
417 : CASE ("DX")
418 16 : CALL parser_get_object(parser, pot%dx)
419 : CASE ("XMIN")
420 16 : CALL parser_get_object(parser, pot%xmin)
421 : CASE ("RMAX")
422 16 : CALL parser_get_object(parser, pot%rmax)
423 : CASE ("MESH")
424 16 : CALL parser_get_object(parser, jj)
425 16 : CPASSERT(pot%mesh_size == jj)
426 : CASE ("ZMESH")
427 16 : CALL parser_get_object(parser, pot%zmesh)
428 : CASE DEFAULT
429 80 : CPABORT("Unknown UPF PP_MESH option <"//TRIM(string)//"> found")
430 : END SELECT
431 :
432 : END DO
433 :
434 16 : END SUBROUTINE upf_mesh_option
435 :
436 : ! **************************************************************************************************
437 : !> \brief ...
438 : !> \param parser ...
439 : !> \param pot ...
440 : ! **************************************************************************************************
441 16 : 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 80 : CALL parser_get_next_line(parser, 1, at_end)
451 80 : CPASSERT(.NOT. at_end)
452 80 : CALL parser_get_object(parser, string, lower_to_upper=.TRUE.)
453 16 : SELECT CASE (string)
454 : CASE ("<PP_R")
455 16 : m = pot%mesh_size
456 16 : ms = pot%mesh_size
457 16 : mc = 1
458 16 : IF (string(6:6) /= ">") THEN
459 : ! options
460 : DO
461 64 : IF (parser_test_next_token(parser) == "EOL") THEN
462 0 : CALL parser_get_next_line(parser, 1, at_end)
463 64 : CPASSERT(.NOT. at_end)
464 : END IF
465 64 : CALL parser_get_object(parser, string2, lower_to_upper=.TRUE.)
466 64 : IF (string2 == ">") EXIT
467 16 : SELECT CASE (string2)
468 : CASE ("TYPE")
469 16 : CALL parser_get_object(parser, line, lower_to_upper=.TRUE.)
470 16 : CPASSERT(line == "REAL")
471 : CASE ("SIZE")
472 16 : CALL parser_get_object(parser, ms)
473 16 : CPASSERT(ms <= m)
474 : CASE ("COLUMNS")
475 16 : CALL parser_get_object(parser, mc)
476 : CASE DEFAULT
477 48 : CPABORT("Unknown UPF PP_R option <"//TRIM(string2)//"> found")
478 : END SELECT
479 : END DO
480 : END IF
481 48 : ALLOCATE (pot%r(m))
482 15184 : pot%r = 0.0_dp
483 : icount = 1
484 16 : DO
485 18970 : IF (parser_test_next_token(parser) == "EOL") THEN
486 3802 : CALL parser_get_next_line(parser, 1, at_end)
487 3802 : CPASSERT(.NOT. at_end)
488 34138 : ELSE IF (parser_test_next_token(parser) == "FLT") THEN
489 15168 : CALL parser_get_object(parser, pot%r(icount))
490 30336 : icount = icount + 1
491 : END IF
492 18970 : IF (icount > ms) EXIT
493 : END DO
494 : CASE ("<PP_RAB")
495 16 : IF (string(6:6) /= ">") THEN
496 : ! options
497 : DO
498 64 : IF (parser_test_next_token(parser) == "EOL") THEN
499 0 : CALL parser_get_next_line(parser, 1, at_end)
500 64 : CPASSERT(.NOT. at_end)
501 : END IF
502 64 : CALL parser_get_object(parser, string2, lower_to_upper=.TRUE.)
503 64 : IF (string2 == ">") EXIT
504 16 : SELECT CASE (string2)
505 : CASE ("TYPE")
506 16 : CALL parser_get_object(parser, line, lower_to_upper=.TRUE.)
507 16 : CPASSERT(line == "REAL")
508 : CASE ("SIZE")
509 16 : CALL parser_get_object(parser, ms)
510 16 : CPASSERT(ms <= m)
511 : CASE ("COLUMNS")
512 16 : CALL parser_get_object(parser, mc)
513 : CASE DEFAULT
514 48 : CPABORT("Unknown UPF PP_RAB option <"//TRIM(string2)//"> found")
515 : END SELECT
516 : END DO
517 : END IF
518 48 : ALLOCATE (pot%rab(m))
519 15184 : pot%rab = 0.0_dp
520 : icount = 1
521 : DO
522 18970 : IF (parser_test_next_token(parser) == "EOL") THEN
523 3802 : CALL parser_get_next_line(parser, 1, at_end)
524 3802 : CPASSERT(.NOT. at_end)
525 34138 : ELSE IF (parser_test_next_token(parser) == "FLT") THEN
526 15168 : CALL parser_get_object(parser, pot%rab(icount))
527 30336 : icount = icount + 1
528 : END IF
529 18970 : IF (icount > ms) EXIT
530 : END DO
531 : CASE ("</PP_MESH>")
532 80 : EXIT
533 : CASE DEFAULT
534 : !
535 : END SELECT
536 : END DO
537 :
538 16 : END SUBROUTINE upf_mesh_section
539 :
540 : ! **************************************************************************************************
541 : !> \brief ...
542 : !> \param parser ...
543 : !> \param pot ...
544 : !> \param options ...
545 : ! **************************************************************************************************
546 0 : 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 0 : m = pot%mesh_size
556 0 : ms = m
557 0 : mc = 1
558 0 : IF (options) THEN
559 : DO
560 0 : IF (parser_test_next_token(parser) == "EOL") THEN
561 0 : CALL parser_get_next_line(parser, 1, at_end)
562 0 : CPASSERT(.NOT. at_end)
563 : END IF
564 0 : CALL parser_get_object(parser, string, lower_to_upper=.TRUE.)
565 0 : IF (string == ">") EXIT
566 0 : SELECT CASE (string)
567 : CASE ("TYPE")
568 0 : CALL parser_get_object(parser, line, lower_to_upper=.TRUE.)
569 0 : CPASSERT(line == "REAL")
570 : CASE ("SIZE")
571 0 : CALL parser_get_object(parser, ms)
572 0 : CPASSERT(ms <= m)
573 : CASE ("COLUMNS")
574 0 : CALL parser_get_object(parser, mc)
575 : CASE DEFAULT
576 0 : CPABORT("Unknown UPF PP_NLCC option <"//TRIM(string)//"> found")
577 : END SELECT
578 : END DO
579 : END IF
580 :
581 0 : ALLOCATE (pot%rho_nlcc(m))
582 0 : pot%rho_nlcc = 0.0_dp
583 : icount = 1
584 : DO
585 0 : IF (parser_test_next_token(parser) == "EOL") THEN
586 0 : CALL parser_get_next_line(parser, 1, at_end)
587 0 : CPASSERT(.NOT. at_end)
588 0 : ELSE IF (parser_test_next_token(parser) == "FLT") THEN
589 0 : CALL parser_get_object(parser, pot%rho_nlcc(icount))
590 0 : icount = icount + 1
591 : END IF
592 0 : IF (icount > ms) EXIT
593 : END DO
594 :
595 0 : CALL parser_get_next_line(parser, 1, at_end)
596 0 : CPASSERT(.NOT. at_end)
597 0 : CALL parser_get_object(parser, string, lower_to_upper=.TRUE.)
598 0 : CPASSERT(string == "</PP_NLCC>")
599 :
600 0 : END SUBROUTINE upf_nlcc_section
601 :
602 : ! **************************************************************************************************
603 : !> \brief ...
604 : !> \param parser ...
605 : !> \param pot ...
606 : !> \param options ...
607 : ! **************************************************************************************************
608 16 : 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 16 : m = pot%mesh_size
618 16 : ms = m
619 16 : mc = 1
620 16 : IF (options) THEN
621 : DO
622 64 : IF (parser_test_next_token(parser) == "EOL") THEN
623 0 : CALL parser_get_next_line(parser, 1, at_end)
624 64 : CPASSERT(.NOT. at_end)
625 : END IF
626 64 : CALL parser_get_object(parser, string, lower_to_upper=.TRUE.)
627 64 : IF (string == ">") EXIT
628 16 : SELECT CASE (string)
629 : CASE ("TYPE")
630 16 : CALL parser_get_object(parser, line, lower_to_upper=.TRUE.)
631 16 : CPASSERT(line == "REAL")
632 : CASE ("SIZE")
633 16 : CALL parser_get_object(parser, ms)
634 16 : CPASSERT(ms <= m)
635 : CASE ("COLUMNS")
636 16 : CALL parser_get_object(parser, mc)
637 : CASE DEFAULT
638 48 : CPABORT("Unknown UPF PP_LOCAL option <"//TRIM(string)//"> found")
639 : END SELECT
640 : END DO
641 : END IF
642 :
643 48 : ALLOCATE (pot%vlocal(m))
644 15184 : pot%vlocal = 0.0_dp
645 : icount = 1
646 : DO
647 18970 : IF (parser_test_next_token(parser) == "EOL") THEN
648 3802 : CALL parser_get_next_line(parser, 1, at_end)
649 3802 : CPASSERT(.NOT. at_end)
650 34138 : ELSE IF (parser_test_next_token(parser) == "FLT") THEN
651 15168 : CALL parser_get_object(parser, pot%vlocal(icount))
652 30336 : icount = icount + 1
653 : END IF
654 18970 : IF (icount > ms) EXIT
655 : END DO
656 :
657 : ! Ry -> Hartree
658 15184 : pot%vlocal = 0.5_dp*pot%vlocal
659 :
660 16 : CALL parser_get_next_line(parser, 1, at_end)
661 16 : CPASSERT(.NOT. at_end)
662 16 : CALL parser_get_object(parser, string, lower_to_upper=.TRUE.)
663 16 : CPASSERT(string == "</PP_LOCAL>")
664 :
665 16 : END SUBROUTINE upf_local_section
666 :
667 : ! **************************************************************************************************
668 : !> \brief ...
669 : !> \param parser ...
670 : !> \param pot ...
671 : ! **************************************************************************************************
672 16 : 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 16 : m = pot%mesh_size
682 16 : nbeta = pot%number_of_proj
683 120 : ALLOCATE (pot%dion(nbeta, nbeta), pot%beta(m, nbeta), pot%lbeta(nbeta))
684 56 : pot%dion = 0.0_dp
685 11468 : pot%beta = 0.0_dp
686 30 : pot%lbeta = -1
687 :
688 : ibeta = 0
689 : DO
690 70 : CALL parser_get_next_line(parser, 1, at_end)
691 70 : CPASSERT(.NOT. at_end)
692 70 : CALL parser_get_object(parser, string, lower_to_upper=.TRUE.)
693 86 : IF (string(1:8) == "<PP_BETA") THEN
694 14 : ms = m
695 14 : ibeta = ibeta + 1
696 14 : i1 = ibeta
697 14 : la = 0
698 14 : CPASSERT(ibeta <= nbeta)
699 : DO
700 140 : IF (parser_test_next_token(parser) == "EOL") THEN
701 14 : CALL parser_get_next_line(parser, 1, at_end)
702 154 : CPASSERT(.NOT. at_end)
703 : END IF
704 140 : CALL parser_get_object(parser, string, lower_to_upper=.TRUE.)
705 140 : IF (string == ">") EXIT
706 14 : SELECT CASE (string)
707 : CASE ("TYPE")
708 14 : CALL parser_get_object(parser, line, lower_to_upper=.TRUE.)
709 14 : CPASSERT(line == "REAL")
710 : CASE ("SIZE")
711 14 : CALL parser_get_object(parser, ms)
712 14 : CPASSERT(ms <= m)
713 : CASE ("COLUMNS")
714 14 : CALL parser_get_object(parser, mc)
715 : CASE ("INDEX")
716 14 : CALL parser_get_object(parser, i1)
717 14 : CPASSERT(i1 <= nbeta)
718 : CASE ("ANGULAR_MOMENTUM")
719 28 : CALL parser_get_object(parser, la)
720 : CASE ("LABEL")
721 14 : CALL parser_get_object(parser, line)
722 : ! not used currently
723 : CASE ("CUTOFF_RADIUS_INDEX")
724 14 : CALL parser_get_object(parser, line)
725 : ! not used currently
726 : CASE ("CUTOFF_RADIUS")
727 14 : CALL parser_get_object(parser, line)
728 : ! not used currently
729 : CASE ("ULTRASOFT_CUTOFF_RADIUS")
730 14 : CALL parser_get_object(parser, line)
731 : ! not used currently
732 : CASE DEFAULT
733 126 : CPABORT("Unknown UPF PP_BETA option <"//TRIM(string)//"> found")
734 : END SELECT
735 : END DO
736 14 : pot%lbeta(i1) = la
737 14 : icount = 1
738 : DO
739 14306 : IF (parser_test_next_token(parser) == "EOL") THEN
740 2868 : CALL parser_get_next_line(parser, 1, at_end)
741 2868 : CPASSERT(.NOT. at_end)
742 25744 : ELSE IF (parser_test_next_token(parser) == "FLT") THEN
743 11438 : CALL parser_get_object(parser, pot%beta(icount, i1))
744 22876 : icount = icount + 1
745 : END IF
746 14306 : IF (icount > ms) EXIT
747 : END DO
748 56 : ELSE IF (string(1:7) == "<PP_DIJ") THEN
749 16 : ms = nbeta*nbeta
750 : DO
751 64 : IF (parser_test_next_token(parser) == "EOL") THEN
752 0 : CALL parser_get_next_line(parser, 1, at_end)
753 64 : CPASSERT(.NOT. at_end)
754 : END IF
755 64 : CALL parser_get_object(parser, string, lower_to_upper=.TRUE.)
756 64 : IF (string == ">") EXIT
757 16 : SELECT CASE (string)
758 : CASE ("TYPE")
759 16 : CALL parser_get_object(parser, line, lower_to_upper=.TRUE.)
760 16 : CPASSERT(line == "REAL")
761 : CASE ("SIZE")
762 16 : CALL parser_get_object(parser, ms)
763 16 : CPASSERT(ms <= m)
764 : CASE ("COLUMNS")
765 16 : CALL parser_get_object(parser, mc)
766 : CASE DEFAULT
767 48 : CPABORT("Unknown UPF PP_DIJ option <"//TRIM(string)//"> found")
768 : END SELECT
769 : END DO
770 : icount = 1
771 : DO
772 46 : IF (parser_test_next_token(parser) == "EOL") THEN
773 20 : CALL parser_get_next_line(parser, 1, at_end)
774 20 : CPASSERT(.NOT. at_end)
775 72 : ELSE IF (parser_test_next_token(parser) == "FLT") THEN
776 26 : i1 = (icount - 1)/nbeta + 1
777 26 : i2 = MOD(icount - 1, nbeta) + 1
778 26 : CALL parser_get_object(parser, pot%dion(i1, i2))
779 52 : icount = icount + 1
780 : END IF
781 46 : IF (icount > ms) EXIT
782 : END DO
783 : ELSE IF (string(1:7) == "<PP_QIJL") THEN
784 : ! skip this option
785 40 : 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 56 : pot%dion = 2.0_dp*pot%dion
792 11468 : pot%beta = 0.5_dp*pot%beta
793 :
794 16 : END SUBROUTINE upf_nonlocal_section
795 :
796 : ! **************************************************************************************************
797 : !> \brief ...
798 : !> \param parser ...
799 : !> \param pot ...
800 : ! **************************************************************************************************
801 2 : 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 2 : m = pot%mesh_size
810 2 : lmax = pot%l_max
811 8 : ALLOCATE (pot%vsemi(m, lmax + 1))
812 3698 : pot%vsemi = 0.0_dp
813 :
814 : ib = 0
815 : DO
816 14 : CALL parser_get_next_line(parser, 1, at_end)
817 14 : CPASSERT(.NOT. at_end)
818 14 : CALL parser_get_object(parser, string, lower_to_upper=.TRUE.)
819 16 : IF (string(1:7) == "<PP_VNL") THEN
820 6 : ms = m
821 6 : ib = ib + 1
822 6 : i1 = ib
823 6 : la = 0
824 6 : CPASSERT(ib <= lmax + 1)
825 : DO
826 30 : IF (parser_test_next_token(parser) == "EOL") THEN
827 0 : CALL parser_get_next_line(parser, 1, at_end)
828 30 : CPASSERT(.NOT. at_end)
829 : END IF
830 30 : CALL parser_get_object(parser, string, lower_to_upper=.TRUE.)
831 30 : IF (string == ">") EXIT
832 6 : SELECT CASE (string)
833 : CASE ("TYPE")
834 6 : CALL parser_get_object(parser, line, lower_to_upper=.TRUE.)
835 6 : CPASSERT(line == "REAL")
836 : CASE ("SIZE")
837 6 : CALL parser_get_object(parser, ms)
838 6 : CPASSERT(ms <= m)
839 : CASE ("COLUMNS")
840 6 : CALL parser_get_object(parser, mc)
841 : CASE ("L")
842 6 : CALL parser_get_object(parser, la)
843 : CASE DEFAULT
844 24 : CPABORT("Unknown UPF PP_VNL option <"//TRIM(string)//"> found")
845 : END SELECT
846 : END DO
847 6 : i1 = la + 1
848 6 : icount = 1
849 : DO
850 3462 : IF (parser_test_next_token(parser) == "EOL") THEN
851 696 : CALL parser_get_next_line(parser, 1, at_end)
852 696 : CPASSERT(.NOT. at_end)
853 6228 : ELSE IF (parser_test_next_token(parser) == "FLT") THEN
854 2766 : CALL parser_get_object(parser, pot%vsemi(icount, i1))
855 5532 : icount = icount + 1
856 : END IF
857 3462 : IF (icount > ms) EXIT
858 : END DO
859 8 : ELSEIF (string(1:15) == "</PP_SEMILOCAL>") THEN
860 : EXIT
861 : ELSE
862 : !
863 : END IF
864 : END DO
865 : ! Ry -> Hartree
866 3698 : pot%vsemi = 0.5_dp*pot%vsemi
867 :
868 2 : END SUBROUTINE upf_semilocal_section
869 :
870 : ! **************************************************************************************************
871 : !> \brief ...
872 : !> \param upfpot ...
873 : ! **************************************************************************************************
874 9482 : PURE SUBROUTINE atom_release_upf(upfpot)
875 :
876 : TYPE(atom_upfpot_type), INTENT(INOUT) :: upfpot
877 :
878 9482 : IF (ALLOCATED(upfpot%r)) DEALLOCATE (upfpot%r)
879 9482 : IF (ALLOCATED(upfpot%rab)) DEALLOCATE (upfpot%rab)
880 9482 : IF (ALLOCATED(upfpot%vlocal)) DEALLOCATE (upfpot%vlocal)
881 9482 : IF (ALLOCATED(upfpot%dion)) DEALLOCATE (upfpot%dion)
882 9482 : IF (ALLOCATED(upfpot%beta)) DEALLOCATE (upfpot%beta)
883 9482 : IF (ALLOCATED(upfpot%lbeta)) DEALLOCATE (upfpot%lbeta)
884 9482 : IF (ALLOCATED(upfpot%vsemi)) DEALLOCATE (upfpot%vsemi)
885 :
886 9482 : END SUBROUTINE atom_release_upf
887 : ! **************************************************************************************************
888 :
889 0 : END MODULE atom_upf
|
