(git:ccc2433)
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 ! **************************************************************************************************
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  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 
889 END MODULE atom_upf
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