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 :
|
