Branch data Line data Source code
1 : : !!****m* ABINIT/m_psxml2ab
2 : : !! NAME
3 : : !! m_psxml2ab
4 : : !!
5 : : !! FUNCTION
6 : : !! From a SIESTA XML format pseudopotential file
7 : : !! convert to abinit internal datastructures for pspheader.
8 : : !!
9 : : !! COPYRIGHT
10 : : !! Copyright (C) 2005-2026 ABINIT group (MJV).
11 : : !! This file is distributed under the terms of the
12 : : !! GNU General Public License, see ~abinit/COPYING
13 : : !! or http://www.gnu.org/copyleft/gpl.txt .
14 : : !! For the initials of contributors, see ~abinit/doc/developers/contributors.txt .
15 : : !!
16 : : !! INPUTS
17 : : !! psxml = pseudopotential data structure
18 : : !!
19 : : !! OUTPUT
20 : : !! psphead = psp information structure
21 : : !! atmsymb = atomic symbol
22 : : !!
23 : : !! SOURCE
24 : :
25 : : #if defined HAVE_CONFIG_H
26 : : #include "config.h"
27 : : #endif
28 : :
29 : : #include "abi_common.h"
30 : :
31 : : module m_psxml2ab
32 : :
33 : : use defs_basis
34 : : use m_abicore
35 : : use m_errors
36 : : #ifdef HAVE_LIBPSML
37 : : use m_psml
38 : : use m_psml_api
39 : : #endif
40 : :
41 : : use defs_datatypes, only : pspheader_type
42 : : use m_fstrings, only : yesno
43 : :
44 : : implicit none
45 : :
46 : : private
47 : :
48 : : #ifdef HAVE_LIBPSML
49 : : public :: psxml2abheader
50 : : !public :: psxml2abfull
51 : :
52 : : CONTAINS
53 : :
54 : 26 : subroutine psxml2abheader(psxmlfile, psphead, atmsymb, creator, iwrite)
55 : :
56 : : !Arguments ------------------------------------
57 : : !scalars
58 : : integer, intent(in) :: iwrite
59 : : character(len=fnlen), intent(in) :: psxmlfile
60 : : type(pspheader_type),intent(inout) :: psphead
61 : : character(len=3), intent(out) :: atmsymb
62 : : character(len=30), intent(out) :: creator
63 : :
64 : : !Local variables-------------------------------
65 : : !scalars
66 : : character(len=500) :: flavor, frmt_str, label, message, relat, xc_name
67 : : character(len=1) :: g1,g2
68 : : integer :: dd,dm,dy
69 : : integer :: il,lmm,ii
70 : : integer :: nxc
71 : : integer :: ishell, nvshells, shell_l, shell_n
72 : : integer :: iproj, ll, ll_previous, nprojs, nprojsr, nprojso
73 : : integer,parameter :: n1xccc_default=2501
74 : : logical :: has_nlcc, has_spin
75 : : #if defined HAVE_LIBPSML_METAGGA
76 : : logical :: has_metagga
77 : : #endif
78 : : real(dp) :: ekb
79 : 26 : type(ps_t) :: psxml
80 : : !arrays
81 : 26 : integer, allocatable :: idx_sr(:), idx_so(:)
82 : 26 : real(dp),allocatable :: zeld(:),zelu(:)
83 : :
84 : : ! *********************************************************************
85 : :
86 : 26 : call ps_destroy(psxml)
87 : 26 : call psml_reader(psxmlfile, psxml, debug=.true.)
88 : :
89 : 26 : psphead%pspdat = 0
90 : 26 : call ps_Provenance_Get(psxml, 1, creator=creator, date=message)
91 : : read (message(1:10), '(I4,A1,I2,A1,I2)', err=10) &
92 [ + + ]: 26 : & dy, g1, dm, g2, dd
93 : 14 : psphead%pspdat = MODULO(dy,100) * 10000 + dm * 100 + dd
94 : :
95 : : 10 continue
96 : :
97 : : #if defined HAVE_LIBPSML_METAGGA
98 : : call ps_PseudoAtomSpec_Get(psxml, &
99 : : & atomic_symbol=atmsymb, atomic_label=label, &
100 : : & atomic_number=psphead%znuclpsp, z_pseudo=psphead%zionpsp, &
101 : : & pseudo_flavor=flavor, relativity=relat, &
102 : 26 : & spin_dft=has_spin, core_corrections=has_nlcc, meta_gga=has_metagga)
103 : : #else
104 : : call ps_PseudoAtomSpec_Get(psxml, &
105 : : & atomic_symbol=atmsymb, atomic_label=label, &
106 : : & atomic_number=psphead%znuclpsp, z_pseudo=psphead%zionpsp, &
107 : : & pseudo_flavor=flavor, relativity=relat, &
108 : : & spin_dft=has_spin, core_corrections=has_nlcc)
109 : : #endif
110 : :
111 : 26 : psphead%pspcod = 9
112 : :
113 : : ! impose libxc coding for pspxc
114 : 26 : psphead%pspxc = 0
115 : 26 : call ps_ExchangeCorrelation_Get(psxml, n_libxc_functionals=nxc)
116 [ + + ]: 78 : do ii=1, min(2,nxc)
117 : 52 : call ps_LibxcFunctional_Get(psxml, ii, code=dd)
118 : 78 : psphead%pspxc = dd + psphead%pspxc*1000
119 : : end do
120 : 26 : psphead%pspxc = -psphead%pspxc
121 : :
122 : 26 : call ps_ValenceConfiguration_Get(psxml, nshells=nvshells)
123 : :
124 [ + + ]: 26 : if (iwrite == 1) then
125 : 11 : write (message,'(a,a)') '- psxml2ab: ps_PseudoFlavor ', trim(message)
126 : : ! call wrtout(ab_out, message,'COLL')
127 : 11 : call wrtout(std_out, message,'COLL')
128 : 11 : write (message,'(a,I5)') '- psxml2ab: ps_NLibxcFunctionals ', nxc
129 : : ! call wrtout(ab_out, message,'COLL')
130 : 11 : call wrtout(std_out, message,'COLL')
131 : 11 : write (message,'(a,I5)') '- psxml2ab: ps_NValenceShells ', nvshells
132 : : ! call wrtout(ab_out, message,'COLL')
133 : 11 : call wrtout(std_out, message,'COLL')
134 : : #if defined HAVE_LIBPSML_METAGGA
135 [ + + ]: 11 : if (has_metagga) then
136 : 1 : write (message,'(a)') '- psxml2ab: Pseudopotential includes meta-GGA kinetic energy density data.'
137 : 1 : call wrtout(std_out, message,'COLL')
138 : : end if
139 : : #endif
140 : : end if
141 : :
142 [ - + + - : 78 : ABI_MALLOC(zeld, (nvshells))
+ - + - -
+ - + -
+ ]
143 [ - + + - : 52 : ABI_MALLOC(zelu, (nvshells))
- + - + -
+ ]
144 [ + + ]: 86 : zeld = zero
145 [ + + ]: 86 : zelu = zero
146 : 26 : frmt_str="(a"
147 [ + + ]: 86 : do ishell = 1, nvshells
148 [ - + ]: 60 : if (has_spin) then
149 : : call ps_ValenceShell_Get(psxml, ishell, n=shell_n, l=shell_l, &
150 : 0 : & occ_up=zelu(ishell), occ_down=zeld(ishell))
151 : : else
152 : : call ps_ValenceShell_Get(psxml, ishell, n=shell_n, l=shell_l, &
153 : 60 : & occupation=zeld(ishell))
154 : : end if
155 [ + + ]: 60 : if (iwrite == 1) then
156 : 26 : write (message,'(a,I5)') '- psxml2ab: ps_ValenceShellN ', shell_n
157 : : ! call wrtout(ab_out, message,'COLL')
158 : 26 : call wrtout(std_out, message,'COLL')
159 : 26 : write (message,'(a,I5)') '- psxml2ab: ps_ValenceShellL ', shell_l
160 : : ! call wrtout(ab_out, message,'COLL')
161 : 26 : call wrtout(std_out, message,'COLL')
162 : : end if
163 [ + - ]: 86 : frmt_str = trim(frmt_str) // ", F10.3"
164 : : end do
165 [ + - ]: 26 : frmt_str = trim(frmt_str) // ")"
166 [ + + ]: 26 : if (iwrite == 1) then
167 : 11 : write (message,frmt_str) '- psxml2ab: zeld ', zeld
168 : : ! call wrtout(ab_out, message,'COLL')
169 : 11 : call wrtout(std_out, message,'COLL')
170 : 11 : write (message,frmt_str) '- psxml2ab: zelu ', zelu
171 : : ! call wrtout(ab_out, message,'COLL')
172 : 11 : call wrtout(std_out, message,'COLL')
173 : : end if
174 : :
175 : 26 : psphead%lmax = 0
176 : : nprojs = 0
177 : 26 : nprojsr = 0
178 : 26 : nprojso = 0
179 : 26 : call ps_NonlocalProjectors_Filter(psxml, set=SET_NONREL, number=nprojs)
180 : : call ps_NonlocalProjectors_Filter(psxml, set=SET_SO, number=nprojso, &
181 [ - + ]: 26 : & indexes=idx_so)
182 [ + + ]: 26 : if (nprojs<=0) then
183 : 16 : call ps_NonlocalProjectors_Filter(psxml, set=SET_SREL, number=nprojsr)
184 : : endif
185 [ + + ]: 26 : if (nprojs > 0) then
186 [ - + ]: 10 : call ps_NonlocalProjectors_Filter(psxml, set=SET_NONREL, indexes=idx_sr)
187 : : else
188 [ + - ]: 16 : if (nprojsr > 0) then
189 [ - + ]: 16 : call ps_NonlocalProjectors_Filter(psxml, set=SET_SREL, indexes=idx_sr)
190 : : else
191 : 0 : ABI_BUG('Your psml potential should have either scalar- or non-relativistic projectors')
192 : : endif
193 : : endif
194 [ + + ]: 26 : if (iwrite == 1) then
195 : 11 : write (message,'(a,I5)') '- psxml2ab: ps_Number_of_Projectors not relativistic ',&
196 : 22 : & nprojs
197 : 11 : call wrtout(ab_out, message,'COLL')
198 : 11 : call wrtout(std_out, message,'COLL')
199 : 11 : write (message,'(a,I5)') '- psxml2ab: ps_Number_of_Projectors scalar relativistic ', &
200 : 22 : & nprojsr
201 : 11 : call wrtout(ab_out, message,'COLL')
202 : 11 : call wrtout(std_out, message,'COLL')
203 : : end if
204 : 26 : ll_previous=-1
205 [ + + ]: 160 : do iproj = 1, max(nprojs, nprojsr)
206 : 134 : call ps_Projector_Get(psxml, idx_sr(iproj), l=ll)
207 [ + + ]: 134 : if (iwrite == 1) then
208 [ + + ]: 57 : if(ll/=ll_previous)then
209 : 39 : write (message,'(a,I5)') '- psxml2ab: ps_Projector_L ', ll
210 : 39 : call wrtout(ab_out, message,'COLL')
211 : 39 : call wrtout(std_out, message,'COLL')
212 : 39 : ll_previous=ll
213 : : endif
214 : 57 : call ps_Projector_Get(psxml, idx_sr(iproj), ekb=ekb)
215 : 57 : write (message,'(a,E20.10)') '- psxml2ab: ps_Projector_Ekb ', ekb
216 : 57 : call wrtout(ab_out, message,'COLL')
217 : 57 : call wrtout(std_out, message,'COLL')
218 : : end if
219 : 294 : psphead%lmax = max( psphead%lmax, ll)
220 : : end do
221 [ + - ]: 26 : if(.not.allocated(psphead%nproj)) then
222 [ - + + - : 78 : ABI_MALLOC(psphead%nproj,(0:psphead%lmax))
+ - + - -
+ - + -
+ ]
223 : : endif
224 [ + - ]: 26 : if(.not.allocated(psphead%nprojso)) then
225 [ - + + - : 78 : ABI_MALLOC(psphead%nprojso,(psphead%lmax))
+ - + - -
+ - + -
+ ]
226 : : endif
227 : :
228 : : ! Find the number of projectors per angular momentum shell
229 [ + + ]: 118 : psphead%nproj(:)=0
230 [ + + ]: 26 : if (nprojs > 0) then
231 [ + + ]: 54 : do iproj = 1, nprojs
232 [ + + ]: 44 : if (iwrite == 1) then
233 : 18 : write (message,'(a,2I5)') '- psxml2ab: iproj, idx for nonrel ', iproj, idx_sr(iproj)
234 : : ! call wrtout(ab_out, message,'COLL')
235 : 18 : call wrtout(std_out, message,'COLL')
236 : : end if
237 : 44 : call ps_Projector_Get(psxml, idx_sr(iproj), l=il)
238 : 54 : psphead%nproj(il) = psphead%nproj(il) + 1
239 : : end do
240 : : else
241 [ + - ]: 16 : if (nprojsr > 0) then
242 [ + + ]: 106 : do iproj = 1, nprojsr
243 [ + + ]: 90 : if (iwrite == 1) then
244 : 39 : write (message,'(a,2I5)') '- psxml2ab: iproj, idx for srel ', iproj, idx_sr(iproj)
245 : : ! call wrtout(ab_out, message,'COLL')
246 : 39 : call wrtout(std_out, message,'COLL')
247 : : end if
248 : 90 : call ps_Projector_Get(psxml, idx_sr(iproj), l=il)
249 : 106 : psphead%nproj(il) = psphead%nproj(il) + 1
250 : : end do
251 : : else
252 : 0 : ABI_BUG('Your psml potential should have either scalar- or non- relativistic projectors')
253 : : end if
254 : : end if
255 : :
256 [ + + ]: 92 : psphead%nprojso(:)=0
257 [ - + ]: 26 : do iproj = 1, nprojso
258 [ # # ]: 0 : if (iwrite == 1) then
259 : 0 : write (message,'(a,2I5)') '- psxml2ab: iproj, idx for soc ', iproj, idx_so(iproj)
260 : : ! call wrtout(ab_out, message,'COLL')
261 : 0 : call wrtout(std_out, message,'COLL')
262 : : end if
263 : 0 : call ps_Projector_Get(psxml, idx_so(iproj), l=il)
264 : 26 : psphead%nprojso(il) = psphead%nprojso(il) + 1
265 : : end do
266 [ + + ]: 26 : if (iwrite == 1) then
267 : 11 : write (message,'(a,5I5)') '- psxml2ab: nproj ', psphead%nproj
268 : : ! call wrtout(ab_out, message,'COLL')
269 : 11 : call wrtout(std_out, message,'COLL')
270 : 11 : write (message,'(a,5I5)') '- psxml2ab: nprojso ', psphead%nprojso
271 : : ! call wrtout(ab_out, message,'COLL')
272 : 11 : call wrtout(std_out, message,'COLL')
273 : : end if
274 : :
275 [ + + ]: 26 : if( has_nlcc) then
276 : 16 : psphead%xccc = n1xccc_default
277 : : else
278 : 10 : psphead%xccc = 0
279 : : end if
280 : :
281 : 26 : psphead%pspso = 0
282 [ + + - + ]: 92 : if (sum(abs(psphead%nprojso(:))) > 0) psphead%pspso = 2
283 : :
284 [ + + ]: 26 : if (iwrite == 1) then
285 : 11 : write (message,'(a,I5)') '- psxml2ab: ps_Number_of_Projectors SOC ', nprojso
286 : 11 : call wrtout(ab_out, message,'COLL')
287 : 11 : call wrtout(std_out, message,'COLL')
288 : : end if
289 : 26 : ll_previous=-1
290 [ - + ]: 26 : do iproj = 1, nprojso
291 : 0 : call ps_Projector_Get(psxml, idx_so(iproj), l=ll)
292 [ # # ]: 0 : if (iwrite == 1) then
293 [ # # ]: 0 : if(ll/=ll_previous)then
294 : 0 : write (message,'(a,I5)') '- psxml2ab: ps_Projector_L ', ll
295 : 0 : call wrtout(ab_out, message,'COLL')
296 : 0 : call wrtout(std_out, message,'COLL')
297 : 0 : ll_previous=ll
298 : : endif
299 : 0 : call ps_Projector_Get(psxml, idx_so(iproj), ekb=ekb)
300 : 0 : write (message,'(a,E20.10)') '- psxml2ab: ps_Projector_Ekb ', ekb
301 : 0 : call wrtout(ab_out, message,'COLL')
302 : 0 : call wrtout(std_out, message,'COLL')
303 : : end if
304 : 26 : psphead%lmax = max( psphead%lmax, ll)
305 : : end do
306 : :
307 : 26 : lmm = max( nprojs, nprojsr)
308 : 26 : lmm = max( lmm, nprojso)
309 : :
310 : 26 : write(std_out,'(a,f5.1,a,i4,a,i4)' ) '- psxml2ab: read the values zionpsp=',&
311 : 52 : & psphead%zionpsp,' , pspcod=',psphead%pspcod,' , lmax=',psphead%lmax
312 : :
313 [ + + ]: 26 : if ( iwrite .eq. 1 ) then
314 : :
315 : : write(message,'(a,a)') &
316 : 11 : & '- psxml2ab: Atomic Label: ', &
317 : 22 : & trim(label)
318 : 11 : call wrtout(ab_out, message,'COLL')
319 : 11 : call wrtout(std_out, message,'COLL')
320 : :
321 : : write(message,'(a,f12.5)') &
322 : 11 : & '- psxml2ab: Atomic Number: ', &
323 : 22 : & psphead%znuclpsp
324 : 11 : call wrtout(ab_out, message,'COLL')
325 : 11 : call wrtout(std_out, message,'COLL')
326 : :
327 : : write(message,'(a,f12.5)') &
328 : 11 : & '- psxml2ab: Valence charge: ', &
329 : 22 : & psphead%zionpsp
330 : 11 : call wrtout(ab_out, message,'COLL')
331 : 11 : call wrtout(std_out, message,'COLL')
332 : :
333 : : write(message,'(a,a)') &
334 : 11 : & '- psxml2ab: Pseudopotential generator code : ', &
335 : 22 : & creator
336 : 11 : call wrtout(ab_out, message,'COLL')
337 : 11 : call wrtout(std_out, message,'COLL')
338 : :
339 : : write(message,'(a,i8)') &
340 : 11 : & '- psxml2ab: Date of pseudopotential generation: ', &
341 : 22 : & psphead%pspdat
342 : 11 : call wrtout(ab_out, message,'COLL')
343 : 11 : call wrtout(std_out, message,'COLL')
344 : :
345 : : write(message,'(a,a)') &
346 : 11 : & '- psxml2ab: Pseudopotential flavor: ', &
347 : 22 : & trim(flavor)
348 : 11 : call wrtout(ab_out, message,'COLL')
349 : 11 : call wrtout(std_out, message,'COLL')
350 : :
351 [ + + ]: 33 : do ii = 1, nxc
352 : 22 : call ps_LibxcFunctional_Get(psxml, ii, name=xc_name, code=dd)
353 : : write(message,'(a,I4,2a," (",I4,")")') &
354 : 22 : & '- psxml2ab: Exchange-correlation functional ',ii,' : ', &
355 : 44 : & trim(xc_name), dd
356 : 22 : call wrtout(ab_out, message,'COLL')
357 : 55 : call wrtout(std_out, message,'COLL')
358 : : end do
359 : :
360 : : write(message,'(2a)') &
361 : 11 : & '- psxml2ab: Relativistically generated pseudopotential (not necessarily SOC!): ', &
362 : 22 : & trim(relat)
363 : 11 : call wrtout(ab_out, message,'COLL')
364 : 11 : call wrtout(std_out, message,'COLL')
365 : :
366 : : write(message,'(2a)') &
367 : 11 : & '- psxml2ab: Spin-polarized pseudopotential: ', &
368 : 22 : & yesno(has_spin)
369 : 11 : call wrtout(ab_out, message,'COLL')
370 : 11 : call wrtout(std_out, message,'COLL')
371 : :
372 : : select case(has_nlcc)
373 : : case(.true.)
374 : : write(message, '(a)' ) &
375 : 7 : & '- psxml2ab: XC core correction read in from XML file.'
376 : : case(.false.)
377 : : write(message, '(a)' ) &
378 : 4 : & '- psxml2ab: No core corrections.'
379 : 4 : call wrtout(ab_out,message,'COLL')
380 [ + + ]: 15 : call wrtout(std_out, message,'COLL')
381 : : end select
382 : : end if
383 : :
384 [ - + ]: 26 : ABI_FREE(zeld)
385 [ - + ]: 26 : ABI_FREE(zelu)
386 : :
387 [ + - ]: 26 : if (allocated(idx_sr)) then
388 : 26 : ABI_FREE_NOCOUNT(idx_sr)
389 : : end if
390 [ + - ]: 26 : if (allocated(idx_so)) then
391 : 26 : ABI_FREE_NOCOUNT(idx_so)
392 : : end if
393 : :
394 : 26 : call ps_destroy(psxml)
395 : :
396 [ - + - + : 78 : end subroutine psxml2abheader
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + + -
+ - + - -
+ - + ]
397 : : !!***
398 : : ! end test on compiling with LIBPSML enabled
399 : : #endif
400 : :
401 : : end module m_psxml2ab
402 : : !!***
403 : :
404 : : !!****f* ABINIT/psml_die
405 : : !! NAME
406 : : !! psml_die
407 : : !!
408 : : !! FUNCTION
409 : : !! auxiliary die function for calling libPSML. Needed at link time
410 : : !! allows calling software to decide how fatal the PSML die call actually is.
411 : : !!
412 : : !! COPYRIGHT
413 : : !! Copyright (C) 2005-2026 ABINIT group (MJV).
414 : : !! This file is distributed under the terms of the
415 : : !! GNU General Public License, see ~abinit/COPYING
416 : : !! or http://www.gnu.org/copyleft/gpl.txt .
417 : : !! For the initials of contributors, see ~abinit/doc/developers/contributors.txt .
418 : : !!
419 : : !! INPUTS
420 : : !! str = string with error message
421 : : !!
422 : : !! OUTPUT
423 : : !!
424 : : !! SOURCE
425 : :
426 : 0 : subroutine psml_die(str)
427 : :
428 : : use m_errors
429 : : character(len=*), intent(in) :: str
430 : :
431 : 0 : ABI_BUG(str)
432 : :
433 : 0 : end subroutine psml_die
434 : : !!***
435 : :
|
