Line data Source code
1 : !!****m* ABINIT/m_pawpsp
2 : !! NAME
3 : !! m_pawpsp
4 : !!
5 : !! FUNCTION
6 : !! Module to read PAW atomic data
7 : !!
8 : !! COPYRIGHT
9 : !! Copyright (C) 2012-2026 ABINIT group (MT, FJ,TR, GJ, FB, FrD, AF, GMR, DRH)
10 : !! This file is distributed under the terms of the
11 : !! GNU General Public License, see ~abinit/COPYING
12 : !! or http://www.gnu.org/copyleft/gpl.txt .
13 : !!
14 : !! NOTES
15 : !! FOR DEVELOPERS: in order to preserve the portability of libPAW library,
16 : !! please consult ~abinit/src/??_libpaw/libpaw-coding-rules.txt
17 : !!
18 : !! SOURCE
19 :
20 : #include "libpaw.h"
21 :
22 : module m_pawpsp
23 :
24 : USE_DEFS
25 : USE_MSG_HANDLING
26 : USE_MPI_WRAPPERS
27 : USE_MEMORY_PROFILING
28 :
29 : use m_libpaw_libxc
30 : #if defined LIBPAW_HAVE_FOX
31 : use fox_sax
32 : #endif
33 :
34 : use m_libpaw_tools, only : libpaw_basename, libpaw_get_free_unit
35 :
36 : use m_pawang, only: pawang_type
37 : use m_pawtab, only: pawtab_type, wvlpaw_type, wvlpaw_allocate, wvlpaw_rholoc_free, &
38 : & pawtab_free, wvlpaw_free, wvlpaw_rholoc_nullify, pawtab_bcast, &
39 : & pawtab_set_flags, wvlpaw_allocate, wvlpaw_free, wvlpaw_rholoc_nullify, &
40 : & wvlpaw_rholoc_free
41 : use m_pawxmlps, only: rdpawpsxml_core, paw_setup_t, paw_setuploc, paw_setup_free
42 : use m_pawrad, only: pawrad_type, pawrad_init, pawrad_free, pawrad_copy, &
43 : & pawrad_bcast, pawrad_ifromr, simp_gen, nderiv_gen, bound_deriv, pawrad_deducer0, poisson
44 : use m_paw_numeric, only: paw_splint, paw_spline, paw_smooth, paw_jbessel_4spline
45 : use m_paw_atom, only: atompaw_shapebes, atompaw_vhnzc, atompaw_ehnzc, atompaw_shpfun, &
46 : & atompaw_dij0, atompaw_kij
47 : use m_pawxc, only: pawxc, pawxcm, pawxc_get_usekden
48 : use m_paw_gaussfit, only: gaussfit_projector
49 : use m_paw_lmn
50 : use m_paw_atomorb, only : atomorb_type, ORB_FROZEN
51 :
52 : implicit none
53 :
54 : private
55 :
56 : public:: pawpsp_calc_d5 !calculate up to the 5th derivative
57 : public:: pawpsp_main !main routine to read psp
58 : public:: pawpsp_nl !make paw projector form factors f_l(q)
59 : public:: pawpsp_read !read psp from file
60 : public:: pawpsp_read_header !read header of psp file
61 : public:: pawpsp_init_core !guess the name of the core wf file and initialize a paw_atomorb type for the core
62 : public:: pawpsp_read_corewf !read core wavefunction
63 : public:: pawpsp_read_header_2 !reads pspversion, basis_size and lmn_size
64 : public:: pawpsp_rw_atompaw !read and writes ATOMPAW psp with gaussian |p>
65 : public:: pawpsp_wvl !wavelet and icoulomb>0 related operations
66 : public:: pawpsp_wvl_calc !wavelet related operations
67 : public:: pawpsp_7in !reads non-XML atomic data
68 : public:: pawpsp_17in !reads XML atomic data
69 : public:: pawpsp_calc !calculates atomic quantities from psp info
70 : public:: pawpsp_read_header_xml !read header of psp file for XML
71 : public:: pawpsp_read_pawheader !read header variables from XML objects
72 : public:: pawpsp_bcast ! broadcast PAW psp data
73 : public:: pawpsp_cg !compute sin FFT transform of a density
74 : public:: pawpsp_lo !compute sin FFT transform of local potential
75 :
76 : ! Private procedures
77 : private:: pawpsp_wvl_sin2gauss !convert sin/cos to gaussians
78 : !!***
79 :
80 : !-------------------------------------------------------------------------
81 :
82 : !!****t* m_pawpsp/pawpsp_header_type
83 : !! NAME
84 : !! pawpsp_header_type
85 : !!
86 : !! FUNCTION
87 : !! For PAW, header related data
88 : !!
89 : !! SOURCE
90 :
91 : type, public :: pawpsp_header_type
92 :
93 : !Integer scalars
94 : integer :: basis_size ! Number of elements of the wf basis ((l,n) quantum numbers)
95 : integer :: l_size ! Maximum value of l+1 leading to a non zero Gaunt coefficient
96 : integer :: lmn_size ! Number of elements of the paw basis
97 : integer :: mesh_size ! Dimension of (main) radial mesh
98 : integer :: pawver ! Version number of paw psp format
99 : integer :: shape_type ! Type of shape function
100 : real(dp) :: rpaw ! Radius for paw spheres
101 : real(dp) :: rshp ! Cut-off radius of shape function
102 :
103 : end type pawpsp_header_type
104 : !!***
105 :
106 : CONTAINS
107 : !===========================================================
108 : !!***
109 :
110 : !-------------------------------------------------------------------------
111 :
112 : !!****f* m_pawpsp/pawpsp_nl
113 : !! NAME
114 : !! pawpsp_nl
115 : !!
116 : !! FUNCTION
117 : !! Make paw projector form factors f_l(q) for each l
118 : !!
119 : !! INPUTS
120 : !! indlmn(6,lmnmax)= array giving l,m,n,lm,ln,s for i=lmn
121 : !! lmnmax=max number of (l,m,n) components
122 : !! lnmax=max number of (l,n) components
123 : !! mqgrid=number of grid points for q grid
124 : !! qgrid(mqgrid)=values at which form factors are returned
125 : !! radmesh <type(pawrad_type)>=data containing radial grid information
126 : !! wfll(:,lnmax)=paw projector on radial grid
127 : !!
128 : !! OUTPUT
129 : !! ffspl(mqgrid,2,lnmax)= form factor f_l(q) and second derivative
130 : !!
131 : !! NOTES
132 : !! u_l(r) is the paw projector (input as wfll);
133 : !! j_l(q) is a spherical Bessel function;
134 : !! f_l(q) = $ \int_0^{rmax}[j_l(2\pi q r) u_l(r) r dr]$
135 : !!
136 : !! SOURCE
137 :
138 547 : subroutine pawpsp_nl(ffspl,indlmn,lmnmax,lnmax,mqgrid,qgrid,radmesh,wfll)
139 :
140 : !Arguments ------------------------------------
141 : !scalars
142 : integer,intent(in) :: lmnmax,lnmax,mqgrid
143 : type(pawrad_type),intent(in) :: radmesh
144 : !arrays
145 : integer,intent(in) :: indlmn(6,lmnmax)
146 : real(dp),intent(in) :: qgrid(mqgrid)
147 : real(dp),intent(in) :: wfll(:,:)
148 : real(dp),intent(inout) :: ffspl(mqgrid,2,lnmax)
149 :
150 : !Local variables-------------------------------
151 : !scalars
152 : integer :: ilmn,iln,iln0,iq,ir,ll,meshsz,mmax
153 : real(dp),parameter :: eps=tol14**4,TOLJ=0.001_dp
154 : real(dp) :: arg,argn,bes
155 : real(dp) :: besp,qr
156 : real(dp) :: yp1,ypn
157 : character(len=100) :: msg
158 547 : type(pawrad_type) :: tmpmesh
159 : !arrays
160 547 : real(dp),allocatable :: ff(:),gg(:),rr(:),rr2(:),rr2wf(:),rrwf(:),work(:)
161 :
162 : !*************************************************************************
163 :
164 : !Is mesh beginning with r=0 ?
165 547 : if (radmesh%rad(1)>tol10) then
166 0 : msg='Radial mesh cannot begin with r<>0!'
167 0 : LIBPAW_BUG(msg)
168 : end if
169 :
170 547 : meshsz=size(wfll,1)
171 547 : if (meshsz>radmesh%mesh_size) then
172 0 : msg='wrong size for wfll!'
173 0 : LIBPAW_BUG(msg)
174 : end if
175 :
176 : !Init. temporary arrays and variables
177 1641 : LIBPAW_ALLOCATE(ff,(meshsz))
178 1094 : LIBPAW_ALLOCATE(gg,(meshsz))
179 1094 : LIBPAW_ALLOCATE(rr,(meshsz))
180 1094 : LIBPAW_ALLOCATE(rr2,(meshsz))
181 1094 : LIBPAW_ALLOCATE(rrwf,(meshsz))
182 1094 : LIBPAW_ALLOCATE(rr2wf,(meshsz))
183 1641 : LIBPAW_ALLOCATE(work,(mqgrid))
184 696663 : rr(1:meshsz) =radmesh%rad(1:meshsz)
185 696663 : rr2(1:meshsz)=two_pi*rr(1:meshsz)*rr(1:meshsz)
186 547 : argn=two_pi*qgrid(mqgrid)
187 547 : mmax=meshsz
188 :
189 : !Loop on (l,n) projectors
190 547 : iln0=0
191 6487 : do ilmn=1,lmnmax
192 5940 : iln=indlmn(5,ilmn)
193 6487 : if(iln>iln0) then
194 2490 : iln0=iln;ll=indlmn(1,ilmn)
195 :
196 2490 : ir=meshsz
197 689383 : do while (abs(wfll(ir,iln))<eps)
198 686893 : ir=ir-1
199 : end do
200 2490 : mmax=min(ir+1,meshsz)
201 2490 : if (mmax/=radmesh%int_meshsz) then
202 : call pawrad_init(tmpmesh,mesh_size=meshsz,mesh_type=radmesh%mesh_type, &
203 1297 : & rstep=radmesh%rstep,lstep=radmesh%lstep,r_for_intg=rr(mmax))
204 : else
205 1193 : call pawrad_copy(radmesh,tmpmesh)
206 : end if
207 :
208 3142121 : rrwf(:) =rr (:)*wfll(:,iln)
209 3142121 : rr2wf(:)=rr2(:)*wfll(:,iln)
210 :
211 : ! 1-Compute f_l(0<q<qmax)
212 2490 : if (mqgrid>2) then
213 7496163 : do iq=2,mqgrid-1
214 7493673 : arg=two_pi*qgrid(iq)
215 7385928511 : do ir=1,mmax
216 7378434838 : qr=arg*rr(ir)
217 7378434838 : call paw_jbessel_4spline(bes,besp,ll,0,qr,TOLJ)
218 7385928511 : ff(ir)=bes*rrwf(ir)
219 : end do
220 7496163 : call simp_gen(ffspl(iq,1,iln),ff,tmpmesh)
221 : end do
222 : end if
223 :
224 : ! 2-Compute f_l(q=0) and first derivative
225 2490 : ffspl(1,1,iln)=zero;yp1=zero
226 2490 : if (ll==0) then
227 1090 : call simp_gen(ffspl(1,1,iln),rrwf,tmpmesh)
228 : end if
229 2490 : if (ll==1) then
230 1069 : call simp_gen(yp1,rr2wf,tmpmesh)
231 1069 : yp1=yp1*third
232 : end if
233 :
234 : ! 3-Compute f_l(q=qmax) and first derivative
235 2490 : if (mqgrid>1) then
236 : ! if (ll==0.or.ll==1) then
237 2457164 : do ir=1,mmax
238 2454674 : qr=argn*rr(ir)
239 2454674 : call paw_jbessel_4spline(bes,besp,ll,1,qr,TOLJ)
240 2454674 : ff(ir)=bes*rrwf(ir)
241 2457164 : gg(ir)=besp*rr2wf(ir)
242 : end do
243 2490 : call simp_gen(ffspl(mqgrid,1,iln),ff,tmpmesh)
244 2490 : call simp_gen(ypn,gg,tmpmesh)
245 : else
246 0 : ypn=yp1
247 : end if
248 :
249 : ! 4-Compute second derivative of f_l(q)
250 2490 : call paw_spline(qgrid,ffspl(:,1,iln),mqgrid,yp1,ypn,ffspl(:,2,iln))
251 :
252 2490 : call pawrad_free(tmpmesh)
253 :
254 : ! End loop on (l,n) projectors
255 : end if
256 : end do
257 :
258 547 : LIBPAW_DEALLOCATE(ff)
259 547 : LIBPAW_DEALLOCATE(gg)
260 547 : LIBPAW_DEALLOCATE(rr)
261 547 : LIBPAW_DEALLOCATE(rr2)
262 547 : LIBPAW_DEALLOCATE(rrwf)
263 547 : LIBPAW_DEALLOCATE(rr2wf)
264 547 : LIBPAW_DEALLOCATE(work)
265 :
266 547 : end subroutine pawpsp_nl
267 : !!***
268 :
269 : !-------------------------------------------------------------------------
270 :
271 : !!****f* m_pawpsp/pawpsp_lo
272 : !! NAME
273 : !! pawpsp_lo
274 : !!
275 : !! FUNCTION
276 : !! Compute sine transform to transform from V(r) to q^2 V(q).
277 : !! Computes integrals on (generalized) grid using corrected trapezoidal integration.
278 : !!
279 : !! INPUTS
280 : !! mqgrid=number of grid points in q from 0 to qmax.
281 : !! qgrid(mqgrid)=q grid values (bohr**-1).
282 : !! radmesh <type(pawrad_type)>=data containing radial grid information
283 : !! vloc(:)=V(r) on radial grid.
284 : !! zion=nominal valence charge of atom.
285 : !!
286 : !! OUTPUT
287 : !! epsatm=$ 4\pi\int[r^2 (V(r)+\frac{Zv}{r}dr]$.
288 : !!{{\\ \begin{equation}
289 : !! q2vq(mqgrid)
290 : !! =q^2 V(q)
291 : !! = -\frac{Zv}{\pi}
292 : !! + q^2 4\pi\int[(\frac{\sin(2\pi q r)}{2\pi q r})(r^2 V(r)+r Zv)dr].
293 : !!\end{equation} }}
294 : !! yp1,ypn=derivatives of q^2 V(q) wrt q at q=0 and q=qmax (needed for spline fitter).
295 : !!
296 : !! SOURCE
297 :
298 543 : subroutine pawpsp_lo(epsatm,mqgrid,qgrid,q2vq,radmesh,vloc,yp1,ypn,zion)
299 :
300 : !Arguments----------------------------------------------------------
301 : !scalars
302 : integer,intent(in) :: mqgrid
303 : real(dp),intent(in) :: zion
304 : real(dp),intent(out) :: epsatm,yp1,ypn
305 : type(pawrad_type),intent(in) :: radmesh
306 : !arrays
307 : real(dp),intent(in) :: qgrid(mqgrid)
308 : real(dp),intent(in) :: vloc(:)
309 : real(dp),intent(out) :: q2vq(mqgrid)
310 :
311 : !Local variables ------------------------------
312 : !scalars
313 : integer :: iq,ir,irmax,mesh_size
314 : real(dp) :: arg,r0tor1,r1torm,rmtoin
315 : logical :: begin_r0
316 : !arrays
317 543 : real(dp),allocatable :: ff(:),rvpz(:)
318 :
319 : !************************************************************************
320 :
321 543 : mesh_size=size(vloc)
322 543 : irmax=pawrad_ifromr(radmesh,min(20._dp,radmesh%rmax))
323 543 : irmax=min(irmax,mesh_size)
324 :
325 : !Particular case of a zero potential
326 666632 : if (maxval(abs(vloc(1:irmax)))<=1.e-20_dp) then
327 0 : q2vq=zero;yp1=zero;ypn=zero;epsatm=zero
328 : return
329 : end if
330 :
331 1629 : LIBPAW_ALLOCATE(ff,(mesh_size))
332 1086 : LIBPAW_ALLOCATE(rvpz,(mesh_size))
333 1449017 : ff=zero;rvpz=zero
334 :
335 : !Is mesh beginning with r=0 ?
336 543 : begin_r0=(radmesh%rad(1)<1.e-20_dp)
337 :
338 : !Store r.V+Z
339 666089 : do ir=1,irmax
340 666089 : rvpz(ir)=radmesh%rad(ir)*vloc(ir)+zion
341 : end do
342 :
343 : !===========================================
344 : !=== Compute q^2 v(q) for q=0 separately
345 : !===========================================
346 :
347 : !Integral from 0 to r1 (only if r1<>0)
348 543 : r0tor1=zero;if (.not.begin_r0) &
349 0 : & r0tor1=(zion*0.5_dp+radmesh%rad(1)*vloc(1)/3._dp)*radmesh%rad(1)**2
350 :
351 : !Integral from r1 to rmax
352 666089 : do ir=1,irmax
353 666089 : if (abs(rvpz(ir))>1.e-20_dp) then
354 665546 : ff(ir)=radmesh%rad(ir)*rvpz(ir)
355 : end if
356 : end do
357 :
358 543 : call simp_gen(r1torm,ff,radmesh)
359 :
360 : !Integral from rmax to infinity
361 : !This part is neglected... might be improved.
362 543 : rmtoin=zero
363 :
364 : !Some of the three parts
365 543 : epsatm=four_pi*(r0tor1+r1torm+rmtoin)
366 :
367 543 : q2vq(1)=-zion/pi
368 :
369 : !===========================================
370 : !=== Compute q^2 v(q) for other q''s
371 : !===========================================
372 :
373 : !Loop over q values
374 1659324 : do iq=2,mqgrid
375 1658781 : arg=two_pi*qgrid(iq)
376 :
377 : ! Integral from 0 to r1 (only if r1<>0)
378 1658781 : r0tor1=zero;if (.not.begin_r0) &
379 : & r0tor1=( vloc(1)/arg*sin(arg*radmesh%rad(1)) &
380 0 : & -rvpz(1) *cos(arg*radmesh%rad(1)) +zion )/pi
381 :
382 : ! Integral from r1 to rmax
383 2022560979 : do ir=1,irmax
384 2022560979 : if (abs(rvpz(ir))>1.e-20_dp) ff(ir)=sin(arg*radmesh%rad(ir))*rvpz(ir)
385 : end do
386 1658781 : call simp_gen(r1torm,ff,radmesh)
387 :
388 : ! Integral from rmax to infinity
389 : ! This part is neglected... might be improved.
390 1658781 : rmtoin=zero
391 :
392 : ! Store q^2 v(q)
393 1659324 : q2vq(iq)=-zion/pi + two*qgrid(iq)*(r0tor1+r1torm+rmtoin)
394 : end do
395 :
396 : !===========================================
397 : !=== Compute derivatives of q^2 v(q)
398 : !=== at ends of interval
399 : !===========================================
400 :
401 : !yp(0)=zero
402 543 : yp1=zero
403 :
404 : !yp(qmax)=$ 2\int_0^\infty[(\sin(2\pi qmax r)+(2\pi qmax r)*\cos(2\pi qmax r)(r V(r)+Z) dr]$
405 543 : arg=two_pi*qgrid(mqgrid)
406 :
407 : !Integral from 0 to r1 (only if r1<>0)
408 543 : r0tor1=zero;if (.not.begin_r0) &
409 : & r0tor1=zion*radmesh%rad(1) *sin(arg*radmesh%rad(1)) &
410 : & +three*radmesh%rad(1)*vloc(1)/arg *cos(arg*radmesh%rad(1)) &
411 0 : & +(radmesh%rad(1)**2-one/arg**2)*vloc(1)*sin(arg*radmesh%rad(1))
412 :
413 : !Integral from r1 to rmax
414 666089 : do ir=1,irmax
415 665546 : if (abs(rvpz(ir))>1.e-20_dp) ff(ir)=( arg*radmesh%rad(ir)*cos(arg*radmesh%rad(ir)) &
416 666089 : & + sin(arg*radmesh%rad(ir))) *rvpz(ir)
417 : end do
418 543 : call simp_gen(r1torm,ff,radmesh)
419 :
420 : !Integral from rmax to infinity
421 : !This part is neglected... might be improved.
422 543 : rmtoin=zero
423 :
424 : !Some of the three parts
425 543 : ypn=two*(r0tor1+r1torm+rmtoin)
426 :
427 543 : LIBPAW_DEALLOCATE(ff)
428 543 : LIBPAW_DEALLOCATE(rvpz)
429 :
430 1086 : end subroutine pawpsp_lo
431 : !!***
432 :
433 : !-------------------------------------------------------------------------
434 :
435 : !!****f* m_pawpsp/pawpsp_cg
436 : !! NAME
437 : !! pawpsp_cg
438 : !!
439 : !! FUNCTION
440 : !! Compute sine transform to transform from n(r) to n(q).
441 : !! Computes integrals on (generalized) grid using corrected trapezoidal integration.
442 : !!
443 : !! INPUTS
444 : !! mqgrid=number of grid points in q from 0 to qmax.
445 : !! qgrid(mqgrid)=q grid values (bohr**-1).
446 : !! radmesh <type(pawrad_type)>=data containing radial grid information
447 : !! nr(:)=n(r) on radial grid.
448 : !!
449 : !! OUTPUT
450 : !! dnqdq0= 1/q dn(q)/dq for q=0
451 : !! d2nqdq0 = Gives contribution of d2(tNcore(q))/d2q for q=0
452 : !! compute \int{(16/15)*pi^5*n(r)*r^6* dr}
453 : !!{{\\ \begin{equation}
454 : !! nq(mqgrid)= n(q)
455 : !! = 4\pi\int[(\frac{\sin(2\pi q r)}{2\pi q r})(r^2 n(r))dr].
456 : !!\end{equation} }}
457 : !! yp1,ypn=derivatives of n(q) wrt q at q=0 and q=qmax (needed for spline fitter).
458 : !!
459 : !! SOURCE
460 :
461 3419 : subroutine pawpsp_cg(dnqdq0,d2nqdq0,mqgrid,qgrid,nq,radmesh,nr,yp1,ypn)
462 :
463 : !Arguments----------------------------------------------------------
464 : !scalars
465 : integer,intent(in) :: mqgrid
466 : real(dp),intent(out) :: dnqdq0,d2nqdq0,yp1,ypn
467 : type(pawrad_type),intent(in) :: radmesh
468 : !arrays
469 : real(dp),intent(in) :: nr(:)
470 : real(dp),intent(in) :: qgrid(mqgrid)
471 : real(dp),intent(out) :: nq(mqgrid)
472 :
473 : !Local variables-------------------------------
474 : !scalars
475 : integer :: iq,ir,mesh_size
476 : real(dp) :: aexp,arg,bexp,dn,r0tor1,r1torm,rm,rmtoin
477 : logical :: begin_r0
478 : !character(len=500) :: msg
479 : !arrays
480 3419 : real(dp),allocatable :: ff(:),rnr(:)
481 :
482 : ! *************************************************************************
483 :
484 3419 : mesh_size=min(size(nr),radmesh%mesh_size)
485 10257 : LIBPAW_ALLOCATE(ff,(mesh_size))
486 6838 : LIBPAW_ALLOCATE(rnr,(mesh_size))
487 13473905 : ff=zero;rnr=zero
488 :
489 6738662 : do ir=1,mesh_size
490 6738662 : rnr(ir)=radmesh%rad(ir)*nr(ir)
491 : end do
492 :
493 : !Is mesh beginning with r=0 ?
494 3419 : begin_r0=(radmesh%rad(1)<1.d-20)
495 :
496 : !Adjustment of an exponentional at r_max (n_exp(r)=aexp*Exp[-bexp*r])
497 3419 : rm=radmesh%rad(mesh_size)
498 : dn=one/(12._dp*radmesh%stepint*radmesh%radfact(mesh_size)) &
499 : & *( 3._dp*nr(mesh_size-4) &
500 : & -16._dp*nr(mesh_size-3) &
501 : & +36._dp*nr(mesh_size-2) &
502 : & -48._dp*nr(mesh_size-1) &
503 3419 : & +25._dp*nr(mesh_size))
504 3419 : if (dn<0._dp.and. &
505 : & abs(radmesh%rad(mesh_size)*nr(mesh_size))>1.d-20) then
506 891 : bexp=-dn/nr(mesh_size)
507 891 : if (bexp * rm > 50._dp) then
508 : ! This solves the problem with the weird core charge used in v4[62] in which bexp x rm ~= 10^3
509 : !write(msg,"(a,es16.8)")"Tooooo large bexp * rm: ", bexp*rm, ", setting aexp to 0"
510 : !LIBPAW_WARNING(msg)
511 : bexp=0.001_dp;aexp=zero
512 : else
513 880 : aexp=nr(mesh_size)*exp(bexp*rm)
514 880 : if (abs(aexp)<1.d-20) then
515 2542 : bexp=0.001_dp;aexp=zero
516 : end if
517 : end if
518 : else
519 : bexp=0.001_dp;aexp=zero
520 : end if
521 :
522 : !===========================================
523 : !=== Compute n(q) for q=0 separately
524 : !===========================================
525 :
526 : !Integral from 0 to r1 (only if r1<>0)
527 3419 : r0tor1=zero
528 3419 : if (.not.begin_r0) r0tor1=(rnr(1)*radmesh%rad(1)**2)/3.d0
529 :
530 : !Integral from r1 to rmax
531 6738662 : do ir=1,mesh_size
532 6738662 : if (abs(rnr(ir))>1.d-20) ff(ir)=rnr(ir)*radmesh%rad(ir)
533 : end do
534 3419 : call simp_gen(r1torm,ff,radmesh)
535 :
536 : !Integral from rmax to infinity
537 : !This part is approximated using an exponential density aexp*Exp[-bexp*r]
538 : !(formulae obtained with mathematica)
539 3419 : rmtoin=aexp*exp(-bexp*rm)/bexp**3*(two+two*bexp*rm+bexp*bexp*rm*rm)
540 :
541 : !Some of the three parts
542 3419 : nq(1)=four_pi*(r0tor1+r1torm+rmtoin)
543 :
544 : !===========================================
545 : !=== Compute n(q) for other q''s
546 : !===========================================
547 :
548 : !Loop over q values
549 10341551 : do iq=2,mqgrid
550 10338132 : arg=two_pi*qgrid(iq)
551 :
552 : ! Integral from 0 to r1 (only if r1<>0)
553 10338132 : r0tor1=zero;if (.not.begin_r0) &
554 : & r0tor1=nr(1)*(sin(arg*radmesh%rad(1))/arg/arg&
555 0 : & -radmesh%rad(1)*cos(arg*radmesh%rad(1))/arg)
556 :
557 : ! Integral from r1 to rmax
558 20330779811 : do ir=1,mesh_size
559 20330779811 : if (abs(rnr(ir))>1.d-20) ff(ir)=sin(arg*radmesh%rad(ir))*rnr(ir)
560 : end do
561 10338132 : call simp_gen(r1torm,ff,radmesh)
562 :
563 : ! Integral from rmax to infinity
564 : ! This part is approximated using an exponential density aexp*Exp[-bexp*r]
565 : ! (formulae obtained with mathematica)
566 : rmtoin=aexp*exp(-bexp*rm)/(arg**2+bexp**2)**2 &
567 : & *(arg*(two*bexp+arg**2*rm+bexp**2*rm)*cos(arg*rm) &
568 10338132 : & +(arg**2*(bexp*rm-one)+bexp**2*(bexp*rm+one))*sin(arg*rm))
569 :
570 : ! Store q^2 v(q)
571 10341551 : nq(iq)=two/qgrid(iq)*(r0tor1+r1torm+rmtoin)
572 : end do
573 :
574 : !===========================================
575 : !=== Compute derivatives of n(q)
576 : !=== at ends of interval
577 : !===========================================
578 :
579 : !yp(0)=zero
580 3419 : yp1=zero
581 :
582 : !yp(qmax)=$ 2\int_0^\infty[(-\sin(2\pi qmax r)+(2\pi qmax r)*\cos(2\pi qmax r) r n(r) dr]$
583 3419 : arg=two_pi*qgrid(mqgrid)
584 :
585 : !Integral from 0 to r1 (only if r1<>0)
586 3419 : r0tor1=zero;if (.not.begin_r0) &
587 : & r0tor1=two_pi*nr(1)*(3.d0*radmesh%rad(1)/arg /arg*cos(arg*radmesh%rad(1))+ &
588 0 : & (radmesh%rad(1)**2/arg-3.0d0/arg**3)*sin(arg*radmesh%rad(1)))
589 :
590 : !Integral from r1 to rmax
591 6738662 : do ir=1,mesh_size
592 6735243 : if (abs(rnr(ir))>1.d-20) ff(ir)=(two_pi*radmesh%rad(ir)*cos(arg*radmesh%rad(ir)) &
593 3659217 : & - sin(arg*radmesh%rad(ir))/qgrid(mqgrid)) *rnr(ir)
594 : end do
595 3419 : call simp_gen(r1torm,ff,radmesh)
596 :
597 : !Integral from rmax to infinity
598 : !This part is approximated using an exponential density aexp*Exp[-bexp*r]
599 : !(formulae obtained with mathematica)
600 : rmtoin=-one/(qgrid(mqgrid)*(arg**2+bexp**2)**3) &
601 : & *aexp*exp(-bexp*rm) &
602 : & *((arg**5*rm-two_pi*arg**4*qgrid(mqgrid)*rm*(bexp*rm-two) &
603 : & +two*arg**3*bexp*(bexp*rm+one)+arg*bexp**3*(bexp*rm+two) &
604 : & -four_pi*arg**2*bexp*qgrid(mqgrid)*(bexp**2*rm**2-three) &
605 : & -two_pi*bexp**3*qgrid(mqgrid)*(bexp**2*rm**2+two*bexp*rm+two))*cos(arg*rm) &
606 : & +(two*arg**2*bexp**3*rm+two_pi*arg**5*qgrid(mqgrid)*rm**2 &
607 : & +arg**4*(bexp*rm-one)+bexp**4*(bexp*rm+one) &
608 : & +four_pi*arg**3*qgrid(mqgrid)*(bexp**2*rm**2+two*bexp*rm-one) &
609 3419 : & +two_pi*arg*bexp**2*qgrid(mqgrid)*(bexp**2*rm**2+four*bexp*rm+6._dp))*sin(arg*rm))
610 :
611 : !Some of the three parts
612 3419 : ypn=two/qgrid(mqgrid)*(r0tor1+r1torm+rmtoin)
613 :
614 : !===========================================
615 : !=== Compute 1/q dn(q)/dq at q=0
616 : !===========================================
617 :
618 : !Integral from 0 to r1 (only if r1<>0)
619 3419 : r0tor1=zero
620 3419 : if (.not.begin_r0) r0tor1=(rnr(1)*radmesh%rad(1)**4)/5.d0
621 :
622 : !Integral from r1 to rmax
623 6738662 : do ir=1,mesh_size
624 6738662 : if (abs(rnr(ir))>1.d-20) ff(ir)=rnr(ir)*radmesh%rad(ir)**3
625 : end do
626 3419 : call simp_gen(r1torm,ff,radmesh)
627 :
628 : !Integral from rmax to infinity
629 : !This part is approximated using an exponential density aexp*Exp[-bexp*r]
630 : !(formulae obtained with mathematica)
631 : rmtoin=aexp*exp(-bexp*rm)/bexp**5 &
632 3419 : & *(24._dp+24._dp*bexp*rm+12._dp*bexp**2*rm**2+four*bexp**3*rm**3+bexp**4*rm**4)
633 :
634 : !Some of the three parts
635 3419 : dnqdq0=-(2.d0/3.d0)*two_pi**3*(r0tor1+r1torm+rmtoin)
636 :
637 3419 : LIBPAW_DEALLOCATE(ff)
638 3419 : LIBPAW_DEALLOCATE(rnr)
639 :
640 3419 : d2nqdq0 = 1_dp
641 :
642 10257 : end subroutine pawpsp_cg
643 : !!***
644 :
645 : !-------------------------------------------------------------------------
646 :
647 : !!****f* m_pawpsp/pawpsp_read
648 : !! NAME
649 : !! pawpsp_read
650 : !!
651 : !! FUNCTION
652 : !!
653 : !! INPUTS
654 : !!
655 : !! OUTPUT
656 : !!
657 : !! SIDE EFFECTS
658 : !!
659 : !! NOTES
660 : !! File format of formatted PAW psp input (the 3 first lines
661 : !! have already been read in calling -pspatm- routine) :
662 : !! (1) title (character) line
663 : !! (2) psps%znuclpsp(ipsp), zion, pspdat
664 : !! (3) pspcod, pspxc, lmax, lloc, mmax, r2well
665 : !! (4) psp_version, creatorID
666 : !! (5) basis_size, lmn_size
667 : !! (6) orbitals (for l=1 to basis_size)
668 : !! (7) number_of_meshes
669 : !! For imsh=1 to number_of_meshes
670 : !! (8) mesh_index, mesh_type ,mesh_size, rad_step[, log_step]
671 : !! (9) r_cut(SPH)
672 : !! (10) shape_type, r_shape[, shapefunction arguments]
673 : !! For iln=1 to basis_size
674 : !! (11) comment(character)
675 : !! (12) radial mesh index for phi
676 : !! (13) phi(r) (for ir=1 to phi_meshsz)
677 : !! For iln=1 to basis_size
678 : !! (14) comment(character)
679 : !! (15) radial mesh index for tphi
680 : !! (16) tphi(r) (for ir=1 to phi_mesh_size)
681 : !! For iln=1 to basis_size
682 : !! (17) comment(character)
683 : !! (18) radial mesh index for tproj
684 : !! (19) tproj(r) (for ir=1 to proj_mesh_size)
685 : !! (20) comment(character)
686 : !! (21) radial mesh index for core_density
687 : !! (22) core_density (for ir=1 to core_mesh_size)
688 : !! (23) comment(character)
689 : !! (24) radial mesh index for pseudo_core_density
690 : !! (25) tcore_density (for ir=1 to core_mesh_size)
691 : !! (26) comment(character)
692 : !! (27) Dij0 (for ij=1 to lmn_size*(lmn_size+1)/2)
693 : !! (28) comment(character)
694 : !! (29) Rhoij0 (for ij=1 to lmn_size*(lmn_size+1)/2)
695 : !! (30) comment(character)
696 : !! (31) radial mesh index for Vloc, format of Vloc (0=Vbare, 1=VH(tnzc), 2=VH(tnzc) without nhat in XC)
697 : !! (32) Vloc(r) (for ir=1 to vloc_mesh_size)
698 : !! ===== Following lines only if shape_type=-1 =====
699 : !! For il=1 to 2*max(orbitals)+1
700 : !! (33) comment(character)
701 : !! (34) radial mesh index for shapefunc
702 : !! (35) shapefunc(r)*gnorm(l)*r**l (for ir=1 to shape_mesh_size)
703 : !! (36) comment(character)
704 : !! (37) radial mesh index for pseudo_valence_density
705 : !! (38) tvale(r) (for ir=1 to vale_mesh_size)
706 : !!
707 : !! Comments:
708 : !! * psp_version= ID of PAW_psp version
709 : !! 4 characters string of the form 'pawn' (with n varying)
710 : !! * creatorID= ID of psp generator
711 : !! creatorid=1xyz : psp generated from Holzwarth AtomPAW generator version x.yz
712 : !! creatorid=2xyz : psp generated from Vanderbilt ultra-soft generator version x.yz
713 : !! creatorid=-1: psp for tests (for developpers only)
714 : !! * mesh_type= type of radial mesh
715 : !! mesh_type=1 (regular grid): rad(i)=(i-1)*AA
716 : !! mesh_type=2 (logari. grid): rad(i)=AA*(exp[BB*(i-1)]-1)
717 : !! mesh_type=3 (logari. grid): rad(i>1)=AA*exp[BB*(i-2)] and rad(1)=0
718 : !! mesh_type=4 (logari. grid): rad(i)=-AA*ln[1-BB*(i-1)] with BB=1/n
719 : !! * radial shapefunction type
720 : !! shape_type=-1 ; gl(r)=numeric (read from psp file)
721 : !! shape_type= 1 ; gl(r)=k(r).r^l; k(r)=exp[-(r/sigma)**lambda]
722 : !! shape_type= 2 ; gl(r)=k(r).r^l; k(r)=[sin(pi*r/rshp)/(pi*r/rshp)]**2 if r<=rshp
723 : !! shape_type= 3 ; gl(r)=Alpha(1,l)*jl(q(1,l)*r)+Alpha(2,l)*jl(q(2,l)*r) for each l
724 : !!
725 : !! SOURCE
726 :
727 231 : subroutine pawpsp_read(core_mesh,funit,imainmesh,lmax,&
728 : & ncore,nmesh,pawrad,pawtab,pspversion,radmesh,save_core_msz,&
729 : & tcoretau,tncore,tnvale,tproj,tproj_mesh,usexcnhat_in,usexcnhat_out,vale_mesh,&
730 : & vlocopt,vlocr,vloc_mesh,znucl)
731 :
732 : !Arguments ------------------------------------
733 : integer,intent(in):: funit,lmax,usexcnhat_in
734 : integer,intent(out) :: imainmesh,pspversion,usexcnhat_out,vlocopt
735 : logical,intent(in) :: save_core_msz
736 : real(dp),intent(in):: znucl
737 : !arrays
738 : real(dp),pointer :: ncore(:),tcoretau(:),tncore(:),tnvale(:),tproj(:,:),vlocr(:)
739 : type(pawrad_type),intent(inout) :: pawrad
740 : type(pawrad_type),intent(out) :: core_mesh,tproj_mesh,vale_mesh,vloc_mesh
741 : type(pawrad_type),pointer :: radmesh(:)
742 : type(pawtab_type),intent(inout) :: pawtab
743 : integer,intent(out)::nmesh
744 :
745 : !Local variables-------------------------------
746 : integer :: creatorid,imsh
747 : integer :: icoremesh,ishpfmesh,ivalemesh,ivlocmesh
748 : integer :: ib,il,ilm,ilmn,iln,iprojmesh
749 : integer :: ii,ir,iread1,iread2,jj
750 : integer :: msz,pngau_,ptotgau_
751 : real(dp):: rc,rread1,rread2
752 : real(dp) :: yp1,ypn
753 : !arrays
754 231 : integer,allocatable :: nprj(:)
755 231 : real(dp),allocatable :: shpf(:,:),val(:),vhnzc(:)
756 231 : real(dp),allocatable :: work1(:),work2(:),work3(:),work4(:)
757 : character :: blank=' ',numb=' '
758 : character(len=80) :: pspline
759 : character(len=500) :: msg,submsg
760 : logical :: read_gauss=.false.
761 231 : type(pawrad_type)::shpf_mesh
762 :
763 : ! *************************************************************************
764 :
765 : !==========================================================
766 : !Read lines 4 to 11 of the header
767 :
768 : !This is important for BigDFT in standalone mode
769 231 : call pawpsp_read_header_2(funit,pspversion,pawtab%basis_size,pawtab%lmn_size)
770 :
771 : !Check pspversion for wvl-paw
772 231 : if(pspversion<4 .and. pawtab%has_wvl>0)then
773 : write(msg, '(a,i2,a,a)' )&
774 0 : & 'In reading atomic psp file, finds pspversion=',pspversion,ch10,&
775 0 : & 'For WVL-PAW, pspversion >= 4 is required.'
776 0 : LIBPAW_BUG(msg)
777 : end if
778 :
779 :
780 : !Have to maintain compatibility with Abinit v4.2.x
781 231 : if (pspversion==1) then
782 0 : LIBPAW_ALLOCATE(pawtab%orbitals,(pawtab%basis_size))
783 0 : read(funit,*) (pawtab%orbitals(ib), ib=1,pawtab%basis_size)
784 0 : pawtab%l_size=2*maxval(pawtab%orbitals)+1
785 0 : nmesh=3
786 0 : LIBPAW_DATATYPE_ALLOCATE(radmesh,(nmesh))
787 0 : read(funit,'(a80)') pspline
788 0 : radmesh(1)%lstep=zero
789 0 : read(unit=pspline,fmt=*,err=10,end=10) radmesh(1)%mesh_type,&
790 0 : & radmesh(1)%rstep,radmesh(1)%lstep
791 0 : 10 read(funit,*) pawtab%rpaw
792 0 : read(funit,*) radmesh(1)%mesh_size,radmesh(2)%mesh_size,&
793 0 : & radmesh(3)%mesh_size
794 0 : read(funit,'(a80)') pspline
795 0 : pawtab%shape_lambda=-1;pawtab%shape_sigma=1.d99
796 0 : read(unit=pspline,fmt=*,err=11,end=11) pawtab%shape_type,&
797 0 : & pawtab%shape_lambda,pawtab%shape_sigma
798 0 : 11 read(funit,*) creatorid
799 0 : if (pawtab%shape_type==3) pawtab%shape_type=-1
800 0 : radmesh(2)%mesh_type=radmesh(1)%mesh_type
801 0 : radmesh(3)%mesh_type=radmesh(1)%mesh_type
802 0 : radmesh(2)%rstep=radmesh(1)%rstep
803 0 : radmesh(3)%rstep=radmesh(1)%rstep
804 0 : radmesh(2)%lstep=radmesh(1)%lstep
805 0 : radmesh(3)%lstep=radmesh(1)%lstep
806 : else
807 :
808 : ! Here psp file for Abinit 4.3+
809 693 : LIBPAW_ALLOCATE(pawtab%orbitals,(pawtab%basis_size))
810 1338 : read(funit,*) (pawtab%orbitals(ib), ib=1,pawtab%basis_size)
811 1338 : pawtab%l_size=2*maxval(pawtab%orbitals)+1
812 231 : read(funit,*) nmesh
813 1564 : LIBPAW_DATATYPE_ALLOCATE(radmesh,(nmesh))
814 1102 : do imsh=1,nmesh
815 871 : rread2=zero
816 871 : read(funit,'(a80)') pspline
817 871 : read(unit=pspline,fmt=*,err=20,end=20) ii,iread1,iread2,rread1,rread2
818 : 20 continue
819 1102 : if (ii<=nmesh) then
820 871 : radmesh(ii)%mesh_type=iread1
821 871 : radmesh(ii)%mesh_size=iread2
822 871 : radmesh(ii)%rstep=rread1
823 871 : radmesh(ii)%lstep=rread2
824 : else
825 : write(msg, '(3a)' )&
826 0 : & 'Index of mesh out of range !',ch10,&
827 0 : & 'Action : check your pseudopotential file.'
828 0 : LIBPAW_ERROR(msg)
829 : end if
830 : end do
831 231 : read(funit,*) pawtab%rpaw
832 231 : read(funit,'(a80)') pspline
833 231 : read(unit=pspline,fmt=*) pawtab%shape_type
834 231 : pawtab%shape_lambda=-1;pawtab%shape_sigma=1.d99
835 : end if
836 :
837 : !Initialize radial meshes
838 1102 : do imsh=1,nmesh
839 1102 : call pawrad_init(radmesh(imsh))
840 : end do
841 :
842 : !==========================================================
843 : !Initialize various dims and indexes
844 :
845 1338 : pawtab%l_size=2*maxval(pawtab%orbitals)+1
846 231 : pawtab%lmn2_size=pawtab%lmn_size*(pawtab%lmn_size+1)/2
847 231 : pawtab%ij_size=pawtab%basis_size*(pawtab%basis_size+1)/2
848 231 : pawtab%usexcnhat=usexcnhat_in
849 :
850 : !indlmn calculation (indices for (l,m,n) basis)
851 231 : if (allocated(pawtab%indlmn)) then
852 0 : LIBPAW_DEALLOCATE(pawtab%indlmn)
853 : end if
854 693 : LIBPAW_ALLOCATE(pawtab%indlmn,(6,pawtab%lmn_size))
855 1800 : LIBPAW_BOUND1_ALLOCATE(nprj,BOUNDS(0,maxval(pawtab%orbitals)))
856 19992 : pawtab%indlmn(:,:)=0
857 797 : ilmn=0;iln=0;nprj=0
858 1338 : do ib=1,pawtab%basis_size
859 1107 : il=pawtab%orbitals(ib)
860 1107 : nprj(il)=nprj(il)+1
861 1107 : iln=iln+1
862 3930 : do ilm=1,2*il+1
863 2823 : pawtab%indlmn(1,ilmn+ilm)=il
864 2823 : pawtab%indlmn(2,ilmn+ilm)=ilm-(il+1)
865 2823 : pawtab%indlmn(3,ilmn+ilm)=nprj(il)
866 2823 : pawtab%indlmn(4,ilmn+ilm)=il*il+ilm
867 2823 : pawtab%indlmn(5,ilmn+ilm)=iln
868 3930 : pawtab%indlmn(6,ilmn+ilm)=1
869 : end do
870 1338 : ilmn=ilmn+2*il+1
871 : end do
872 231 : LIBPAW_DEALLOCATE(nprj)
873 : !Are ilmn (found here) and pawtab%lmn_size compatibles ?
874 231 : if (ilmn/=pawtab%lmn_size) then
875 : write(msg, '(a,a,a,a,a)' )&
876 0 : & 'Calculated lmn size differs from',ch10,&
877 0 : & 'lmn_size read from pseudo !',ch10,&
878 0 : & 'Action: check your pseudopotential file.'
879 0 : LIBPAW_ERROR(msg)
880 : end if
881 :
882 : !==========================================================
883 : !Here reading shapefunction parameters
884 :
885 : !Shapefunction parameters for Abinit 4.3...4.5
886 231 : if (pspversion==2) then
887 33 : if (pawtab%shape_type==1) read(unit=pspline,fmt=*) ii,pawtab%shape_lambda,pawtab%shape_sigma
888 33 : if (pawtab%shape_type==3) pawtab%shape_type=-1
889 33 : pawtab%rshp=zero
890 :
891 : !Shapefunction parameters for Abinit 4.6+
892 198 : else if (pspversion>=3) then
893 198 : pawtab%rshp=zero
894 198 : if (pawtab%shape_type==-1) read(unit=pspline,fmt=*,err=21,end=21) ii,pawtab%rshp
895 198 : if (pawtab%shape_type== 1) read(unit=pspline,fmt=*,err=21,end=21) ii,pawtab%rshp, &
896 0 : & pawtab%shape_lambda,pawtab%shape_sigma
897 198 : if (pawtab%shape_type== 2) read(unit=pspline,fmt=*,err=21,end=21) ii,pawtab%rshp
898 198 : if (pawtab%shape_type== 3) read(unit=pspline,fmt=*,err=21,end=21) ii,pawtab%rshp
899 : end if
900 : 21 continue
901 : !If shapefunction type is gaussian, check exponent
902 231 : if (pawtab%shape_type==1) then
903 0 : if (pawtab%shape_lambda<2) then
904 : write(msg, '(3a)' )&
905 0 : & 'For a gaussian shape function, exponent lambda must be >1 !',ch10,&
906 0 : & 'Action: check your psp file.'
907 0 : LIBPAW_ERROR(msg)
908 : end if
909 : end if
910 : !If shapefunction type is Bessel, deduce here its parameters from rc
911 231 : if (pawtab%shape_type==3) then
912 183 : LIBPAW_ALLOCATE(pawtab%shape_alpha,(2,pawtab%l_size))
913 122 : LIBPAW_ALLOCATE(pawtab%shape_q,(2,pawtab%l_size))
914 61 : rc=pawtab%rshp;if (rc<1.d-8) rc=pawtab%rpaw
915 294 : do il=1,pawtab%l_size
916 294 : call atompaw_shapebes(pawtab%shape_alpha(1:2,il),pawtab%shape_q(1:2,il),il-1,rc)
917 : end do
918 : end if
919 :
920 : !==========================================================
921 : !Mirror pseudopotential parameters to the output and log files
922 :
923 231 : write(msg,'(a,i1)')' Pseudopotential format is: paw',pspversion
924 231 : call wrtout(ab_out,msg,'COLL')
925 231 : call wrtout(std_out, msg,'COLL')
926 : write(msg,'(2(a,i3),a,64i4)') &
927 231 : & ' basis_size (lnmax)=',pawtab%basis_size,' (lmn_size=',&
928 462 : & pawtab%lmn_size,'), orbitals=',pawtab%orbitals(1:pawtab%basis_size)
929 231 : call wrtout(ab_out,msg,'COLL')
930 231 : call wrtout(std_out, msg,'COLL')
931 231 : write(msg,'(a,f11.8)')' Spheres core radius: rc_sph=',pawtab%rpaw
932 231 : call wrtout(ab_out,msg,'COLL')
933 231 : call wrtout(std_out, msg,'COLL')
934 231 : write(msg,'(a,i1,a)')' ',nmesh,' radial meshes are used:'
935 231 : call wrtout(ab_out,msg,'COLL')
936 231 : call wrtout(std_out, msg,'COLL')
937 1102 : do imsh=1,nmesh
938 871 : if (radmesh(imsh)%mesh_type==1) &
939 : & write(msg,'(a,i1,a,i4,a,g12.5)') &
940 77 : & ' - mesh ',imsh,': r(i)=step*(i-1), size=',radmesh(imsh)%mesh_size,&
941 154 : & ' , step=',radmesh(imsh)%rstep
942 871 : if (radmesh(imsh)%mesh_type==2) &
943 : & write(msg,'(a,i1,a,i4,2(a,g12.5))') &
944 748 : & ' - mesh ',imsh,': r(i)=AA*[exp(BB*(i-1))-1], size=',radmesh(imsh)%mesh_size,&
945 1496 : & ' , AA=',radmesh(imsh)%rstep,' BB=',radmesh(imsh)%lstep
946 871 : if (radmesh(imsh)%mesh_type==3) &
947 : & write(msg,'(a,i1,a,i4,2(a,g12.5))') &
948 46 : & ' - mesh ',imsh,': r(i)=AA*exp(BB*(i-2)), size=',radmesh(imsh)%mesh_size,&
949 92 : & ' , AA=',radmesh(imsh)%rstep,' BB=',radmesh(imsh)%lstep
950 871 : if (radmesh(imsh)%mesh_type==4) &
951 : & write(msg,'(a,i1,a,i4,a,g12.5)') &
952 0 : & ' - mesh ',imsh,': r(i)=-AA*ln(1-(i-1)/n), n=size=',radmesh(imsh)%mesh_size,&
953 0 : & ' , AA=',radmesh(imsh)%rstep
954 871 : call wrtout(ab_out,msg,'COLL')
955 1102 : call wrtout(std_out, msg,'COLL')
956 : end do
957 231 : if (pawtab%shape_type==-1) then
958 : write(msg,'(a)')&
959 2 : ' Shapefunction is NUMERIC type: directly read from atomic data file'
960 2 : call wrtout(ab_out,msg,'COLL')
961 2 : call wrtout(std_out, msg,'COLL')
962 : end if
963 231 : if (pawtab%shape_type==1) then
964 : write(msg,'(2a,a,f6.3,a,i3)')&
965 0 : & ' Shapefunction is EXP type: shapef(r)=exp(-(r/sigma)**lambda)',ch10,&
966 0 : & ' with sigma=',pawtab%shape_sigma,' and lambda=',pawtab%shape_lambda
967 0 : call wrtout(ab_out,msg,'COLL')
968 0 : call wrtout(std_out, msg,'COLL')
969 : end if
970 231 : if (pawtab%shape_type==2) then
971 : write(msg,'(a)')&
972 168 : ' Shapefunction is SIN type: shapef(r)=[sin(pi*r/rshp)/(pi*r/rshp)]**2'
973 168 : call wrtout(ab_out,msg,'COLL')
974 168 : call wrtout(std_out, msg,'COLL')
975 : end if
976 231 : if (pawtab%shape_type==3) then
977 : write(msg,'(a)')&
978 61 : & ' Shapefunction is BESSEL type: shapef(r,l)=aa(1,l)*jl(q(1,l)*r)+aa(2,l)*jl(q(2,l)*r)'
979 61 : call wrtout(ab_out,msg,'COLL')
980 61 : call wrtout(std_out, msg,'COLL')
981 : end if
982 231 : if (pawtab%rshp<1.d-8) then
983 215 : write(msg,'(a)') ' Radius for shape functions = sphere core radius'
984 : else
985 16 : write(msg,'(a,f11.8)') ' Radius for shape functions = ',pawtab%rshp
986 : end if
987 231 : call wrtout(ab_out,msg,'COLL')
988 231 : call wrtout(std_out, msg,'COLL')
989 :
990 : !==========================================================
991 : !Perfom tests
992 :
993 : !Are lmax and orbitals compatibles ?
994 1338 : if (lmax/=maxval(pawtab%orbitals)) then
995 : write(msg, '(a,a,a)' )&
996 0 : & 'lmax /= MAX(orbitals) !',ch10,&
997 0 : & 'Action: check your pseudopotential file.'
998 0 : LIBPAW_ERROR(msg)
999 : end if
1000 :
1001 : !Only mesh_type=1,2, 3 or 4 allowed
1002 1102 : do imsh=1,nmesh
1003 1102 : if (radmesh(imsh)%mesh_type>4) then
1004 : write(msg, '(a,a,a)' )&
1005 0 : & 'Only mesh types 1,2, 3 or 4 allowed !',ch10,&
1006 0 : & 'Action : check your pseudopotential or input file.'
1007 0 : LIBPAW_ERROR(msg)
1008 : end if
1009 : end do
1010 :
1011 : !==========================================================
1012 : !Read tabulated atomic data
1013 :
1014 : !---------------------------------
1015 : !Read wave-functions (phi)
1016 1338 : do ib=1,pawtab%basis_size
1017 1107 : read (funit,*)
1018 1107 : if (pspversion==1) iread1=1
1019 1107 : if (pspversion>1) read (funit,*) iread1
1020 1107 : if (ib==1) then
1021 231 : call pawrad_free(pawrad)
1022 : call pawrad_init(pawrad,mesh_size=radmesh(iread1)%mesh_size,mesh_type=radmesh(iread1)%mesh_type,&
1023 231 : & rstep=radmesh(iread1)%rstep,lstep=radmesh(iread1)%lstep,r_for_intg=pawtab%rpaw)
1024 231 : pawtab%partialwave_mesh_size=pawrad%mesh_size
1025 231 : pawtab%mesh_size=pawrad_ifromr(pawrad,pawtab%rpaw)+5
1026 231 : pawtab%mesh_size=min(pawtab%mesh_size,pawrad%mesh_size)
1027 231 : if (pawtab%mesh_size>pawrad%mesh_size-2) pawtab%mesh_size=pawrad%mesh_size
1028 231 : imainmesh=iread1
1029 924 : LIBPAW_ALLOCATE(pawtab%phi,(pawtab%partialwave_mesh_size,pawtab%basis_size))
1030 876 : else if (iread1/=imainmesh) then
1031 : write(msg, '(a,a,a)' )&
1032 0 : & 'All Phi and tPhi must be given on the same radial mesh !',ch10,&
1033 0 : & 'Action: check your pseudopotential file.'
1034 0 : LIBPAW_ERROR(msg)
1035 : end if
1036 763197 : read (funit,*) (pawtab%phi(ir,ib),ir=1,pawtab%partialwave_mesh_size)
1037 : end do
1038 :
1039 : !---------------------------------
1040 : !Read pseudo wave-functions (tphi)
1041 924 : LIBPAW_ALLOCATE(pawtab%tphi,(pawtab%partialwave_mesh_size,pawtab%basis_size))
1042 1338 : do ib=1,pawtab%basis_size
1043 1107 : read (funit,*)
1044 1107 : if (pspversion==1) iread1=1
1045 1107 : if (pspversion>1) read (funit,*) iread1
1046 1107 : if (iread1/=imainmesh) then
1047 : write(msg, '(a,a,a)' )&
1048 0 : & 'All Phi and tPhi must be given on the same radial mesh !',ch10,&
1049 0 : & 'Action: check your pseudopotential file.'
1050 0 : LIBPAW_ERROR(msg)
1051 : end if
1052 763197 : read (funit,*) (pawtab%tphi(ir,ib),ir=1,pawtab%partialwave_mesh_size)
1053 : end do
1054 : write(msg,'(a,i1)') &
1055 231 : & ' Radial grid used for partial waves is grid ',imainmesh
1056 231 : call wrtout(ab_out,msg,'COLL')
1057 231 : call wrtout(std_out, msg,'COLL')
1058 :
1059 : !---------------------------------
1060 : !Read projectors (tproj)
1061 1338 : do ib=1,pawtab%basis_size
1062 1107 : read (funit,*)
1063 1107 : if (pspversion==1) iread1=2
1064 1107 : if (pspversion>1) read (funit,*) iread1
1065 1107 : if (ib==1) then
1066 231 : iprojmesh=iread1
1067 231 : call pawrad_copy(radmesh(iprojmesh),tproj_mesh)
1068 924 : LIBPAW_POINTER_ALLOCATE(tproj,(tproj_mesh%mesh_size,pawtab%basis_size))
1069 876 : else if (iread1/=iprojmesh) then
1070 : write(msg, '(a,a,a)' )&
1071 0 : & 'All tprojectors must be given on the same radial mesh !',ch10,&
1072 0 : & 'Action: check your pseudopotential file.'
1073 0 : LIBPAW_ERROR(msg)
1074 : end if
1075 : ! read projectors from a mesh
1076 1338 : read (funit,*) (tproj(ir,ib),ir=1,tproj_mesh%mesh_size)
1077 : end do
1078 : write(msg,'(a,i2)') &
1079 231 : & ' Radial grid used for projectors is grid ',iprojmesh
1080 231 : call wrtout(ab_out,msg,'COLL')
1081 231 : call wrtout(std_out, msg,'COLL')
1082 :
1083 : !---------------------------------
1084 : !Read gaussian projectors for wavelets
1085 : ! -- only if pawtab%has_wvl flag is on
1086 : ! -- if not, we skip the lines
1087 231 : read(funit,'(a80)') pspline
1088 231 : if(index(trim(pspline),'GAUSSIAN')/=0) read_gauss=.true.
1089 231 : if (read_gauss) then
1090 0 : if (pawtab%has_wvl>0) then
1091 0 : call wvlpaw_allocate(pawtab%wvl)
1092 0 : jj=0
1093 0 : do ib=1,pawtab%basis_size
1094 0 : if(ib/=1) read(funit,*) pspline
1095 : ! read Gaussian coefficients
1096 0 : read(funit,*) pngau_, ptotgau_ !total number of gaussians
1097 0 : if(ib==1) then
1098 0 : pawtab%wvl%ptotgau=ptotgau_
1099 0 : LIBPAW_ALLOCATE(pawtab%wvl%pngau,(pawtab%basis_size))
1100 0 : LIBPAW_ALLOCATE(pawtab%wvl%parg,(2,pawtab%wvl%ptotgau))
1101 0 : LIBPAW_ALLOCATE(pawtab%wvl%pfac,(2,pawtab%wvl%ptotgau))
1102 : else
1103 0 : if(pawtab%wvl%ptotgau/=ptotgau_) then
1104 : write(msg,'(3a)')&
1105 0 : & 'Total number of gaussians, should be the same for all projectors !',ch10,&
1106 0 : & 'Action: check your pseudopotential file.'
1107 0 : LIBPAW_ERROR(msg)
1108 : end if
1109 : end if !ib==1
1110 0 : read(funit,*)(pawtab%wvl%parg(:,ii),ii=jj+1,jj+pngau_)
1111 0 : read(funit,*)(pawtab%wvl%pfac(:,ii),ii=jj+1,jj+pngau_)
1112 0 : pawtab%wvl%pngau(ib)=pngau_
1113 0 : jj=jj+pngau_
1114 : end do
1115 0 : pawtab%has_wvl=2
1116 : else
1117 : ! If pawtab%has_wvl=0, we skip the lines
1118 0 : do ib=1,pawtab%basis_size
1119 0 : if(ib/=1) read(funit,*)
1120 0 : read(funit,*) pngau_, ptotgau_
1121 0 : LIBPAW_ALLOCATE(val, (pngau_ *2))
1122 0 : read(funit,*) val
1123 0 : read(funit,*) val
1124 0 : LIBPAW_DEALLOCATE(val)
1125 : end do
1126 : end if
1127 : end if
1128 :
1129 : !---------------------------------
1130 : !Read core density (coredens)
1131 231 : if(read_gauss) read (funit,*) !if not read_gauss, this line was already read
1132 231 : if (pspversion==1) iread1=1
1133 231 : if (pspversion>1) read (funit,*) iread1
1134 231 : icoremesh=iread1
1135 231 : call pawrad_copy(radmesh(icoremesh),core_mesh)
1136 : if ((radmesh(icoremesh)%mesh_type/=pawrad%mesh_type).or.&
1137 231 : & (radmesh(icoremesh)%rstep /=pawrad%rstep) .or.&
1138 : & (radmesh(icoremesh)%lstep /=pawrad%lstep)) then
1139 : write(msg, '(a,a,a,a,a)' )&
1140 0 : & 'Ncore must be given on a radial mesh with the same',ch10,&
1141 0 : & 'type and step(s) than the main radial mesh (mesh for Phi) !',ch10,&
1142 0 : & 'Action: check your pseudopotential file.'
1143 0 : LIBPAW_ERROR(msg)
1144 : end if
1145 693 : LIBPAW_POINTER_ALLOCATE(ncore,(core_mesh%mesh_size))
1146 231 : read (funit,*) (ncore(ir),ir=1,core_mesh%mesh_size)
1147 :
1148 : !Construct and save VH[z_NC] if requested
1149 231 : if (pawtab%has_vhnzc==1) then
1150 693 : LIBPAW_ALLOCATE(pawtab%VHnZC,(pawtab%mesh_size))
1151 693 : LIBPAW_ALLOCATE(vhnzc,(core_mesh%mesh_size))
1152 231 : call atompaw_vhnzc(ncore,core_mesh,vhnzc,znucl)
1153 154173 : pawtab%VHnZC(1:pawtab%mesh_size)=vhnzc(1:pawtab%mesh_size)
1154 231 : pawtab%has_vhnzc=2
1155 231 : LIBPAW_DEALLOCATE(vhnzc)
1156 : end if
1157 :
1158 231 : pawtab%core_mesh_size=pawrad%mesh_size
1159 231 : if(save_core_msz) pawtab%core_mesh_size=core_mesh%mesh_size
1160 693 : LIBPAW_ALLOCATE(pawtab%coredens,(pawtab%core_mesh_size))
1161 231 : pawtab%rcore=core_mesh%rad(pawtab%core_mesh_size)
1162 154173 : pawtab%coredens(1:pawtab%core_mesh_size)=ncore(1:pawtab%core_mesh_size)
1163 :
1164 : !---------------------------------
1165 : !Read pseudo core density (tcoredens)
1166 231 : if(save_core_msz) then
1167 0 : LIBPAW_ALLOCATE(pawtab%tcoredens,(pawtab%core_mesh_size,6))
1168 : else
1169 462 : LIBPAW_ALLOCATE(pawtab%tcoredens,(pawtab%core_mesh_size,1))
1170 : end if
1171 154404 : pawtab%tcoredens=zero
1172 231 : read (funit,*)
1173 231 : if (pspversion==1) iread1=1
1174 231 : if (pspversion>1) read (funit,*) iread1
1175 231 : if (iread1/=icoremesh) then
1176 : write(msg, '(a,a,a,a,a,a,a,a)' )&
1177 0 : & 'Pseudized core density (tNcore) must be given',ch10,&
1178 0 : & 'on the same radial mesh as core density (Ncore) !',ch10,&
1179 0 : & 'Action: check your pseudopotential file.'
1180 0 : LIBPAW_ERROR(msg)
1181 : end if
1182 693 : LIBPAW_POINTER_ALLOCATE(tncore,(core_mesh%mesh_size))
1183 231 : read (funit,*) (tncore(ir),ir=1,core_mesh%mesh_size)
1184 162145 : if (maxval(abs(tncore(:)))<tol6) then
1185 92 : pawtab%usetcore=0
1186 : else
1187 139 : pawtab%usetcore=1
1188 92160 : pawtab%tcoredens(1:pawtab%core_mesh_size,1)=tncore(1:pawtab%core_mesh_size)
1189 : end if
1190 : write(msg,'(a,i1)') &
1191 231 : & ' Radial grid used for (t)core density is grid ',icoremesh
1192 231 : call wrtout(ab_out,msg,'COLL')
1193 231 : call wrtout(std_out, msg,'COLL')
1194 :
1195 : !---------------------------------
1196 : !Read frozen part of Dij terms (dij0)
1197 693 : LIBPAW_ALLOCATE(pawtab%dij0,(pawtab%lmn2_size))
1198 231 : read (funit,*)
1199 23396 : read (funit,*) (pawtab%dij0(ib),ib=1,pawtab%lmn2_size)
1200 :
1201 : !---------------------------------
1202 : !Read initial guess of rhoij (rhoij0)
1203 693 : LIBPAW_ALLOCATE(pawtab%rhoij0,(pawtab%lmn2_size))
1204 231 : read (funit,*)
1205 23396 : read (funit,*) (pawtab%rhoij0(ib),ib=1,pawtab%lmn2_size)
1206 :
1207 : !---------------------------------
1208 : !Read local pseudopotential=Vh(tn_zc) or Vbare
1209 231 : read (funit,*)
1210 231 : if (pspversion==1) ivlocmesh=3
1211 231 : vlocopt=1
1212 231 : if (pspversion==2) then
1213 33 : read (funit,*) ivlocmesh
1214 198 : else if (pspversion>2) then
1215 : ! read (funit,fmt=*,err=30,end=30) ivlocmesh,vlocopt
1216 198 : msg=blank
1217 198 : read (funit,fmt='(a)') msg
1218 198 : read (msg,fmt=*) ivlocmesh
1219 198 : write(numb,'(i1)')ivlocmesh
1220 198 : ii=index(msg,numb)
1221 198 : if(len_trim(trim(msg(ii+1:)))/=0)then
1222 198 : submsg=trim(msg(ii+1:))
1223 198 : if(len_trim(submsg)/=0)then
1224 1020 : do ii=1,len_trim(submsg)
1225 1020 : numb=submsg(ii:ii)
1226 1020 : if(numb==blank)cycle
1227 340 : jj=index('0123456789',numb)
1228 340 : if(jj<1 .or. jj>10)exit
1229 1020 : vlocopt=jj-1
1230 : end do
1231 : end if
1232 : end if
1233 : end if
1234 231 : usexcnhat_out=0;if (vlocopt==1) usexcnhat_out=1
1235 231 : call pawrad_copy(radmesh(ivlocmesh),vloc_mesh)
1236 693 : LIBPAW_POINTER_ALLOCATE(vlocr,(vloc_mesh%mesh_size))
1237 231 : read (funit,*) (vlocr(ir),ir=1,vloc_mesh%mesh_size)
1238 : write(msg,'(a,i1)') &
1239 231 : & ' Radial grid used for Vloc is grid ',ivlocmesh
1240 231 : call wrtout(ab_out,msg,'COLL')
1241 231 : call wrtout(std_out, msg,'COLL')
1242 :
1243 : !---------------------------------
1244 : !Eventually read "numeric" shapefunctions (if shape_type=-1)
1245 231 : if (pawtab%shape_type==-1) then
1246 8 : LIBPAW_ALLOCATE(pawtab%shapefunc,(pawtab%mesh_size,pawtab%l_size))
1247 12 : do il=1,pawtab%l_size
1248 10 : read (funit,*)
1249 10 : if (pspversion==1) iread1=1
1250 10 : if (pspversion>1) read (funit,*) iread1
1251 10 : if (il==1) then
1252 2 : call pawrad_copy(radmesh(iread1),shpf_mesh)
1253 2 : ishpfmesh=iread1
1254 8 : LIBPAW_ALLOCATE(shpf,(shpf_mesh%mesh_size,pawtab%l_size))
1255 8 : else if (iread1/=ishpfmesh) then
1256 : write(msg, '(a,a,a)' )&
1257 0 : & 'All shape functions must be given on the same radial mesh !',ch10,&
1258 0 : & 'Action: check your pseudopotential file.'
1259 0 : LIBPAW_ERROR(msg)
1260 : end if
1261 12 : read (funit,*) (shpf(ir,il),ir=1,shpf_mesh%mesh_size)
1262 : end do
1263 : write(msg,'(a,i1)') &
1264 2 : & ' Radial grid used for shape functions is grid ',iread1
1265 2 : call wrtout(ab_out,msg,'COLL')
1266 2 : call wrtout(std_out, msg,'COLL')
1267 :
1268 : ! Has to spline shape functions if mesh is not the "main" mesh
1269 2 : if (ishpfmesh/=imainmesh) then
1270 0 : msz=shpf_mesh%mesh_size
1271 0 : LIBPAW_ALLOCATE(work1,(msz))
1272 0 : LIBPAW_ALLOCATE(work2,(msz))
1273 0 : LIBPAW_ALLOCATE(work3,(msz))
1274 0 : LIBPAW_ALLOCATE(work4,(pawtab%mesh_size))
1275 0 : work3(1:pawtab%mesh_size)=shpf_mesh%rad(1:pawtab%mesh_size)
1276 0 : work4(1:pawtab%mesh_size)=pawrad%rad(1:pawtab%mesh_size)
1277 0 : do il=1,pawtab%l_size
1278 0 : call bound_deriv(shpf(1:msz,il),shpf_mesh,msz,yp1,ypn)
1279 0 : call paw_spline(work3,shpf(:,il),msz,yp1,ypn,work1)
1280 0 : call paw_splint(msz,work3,shpf(:,il),work1,pawtab%mesh_size,work4,pawtab%shapefunc(:,il))
1281 : end do
1282 0 : LIBPAW_DEALLOCATE(work1)
1283 0 : LIBPAW_DEALLOCATE(work2)
1284 0 : LIBPAW_DEALLOCATE(work3)
1285 0 : LIBPAW_DEALLOCATE(work4)
1286 : else
1287 5952 : pawtab%shapefunc(:,:)=shpf(:,:)
1288 : end if
1289 2 : LIBPAW_DEALLOCATE(shpf)
1290 2 : call pawrad_free(shpf_mesh)
1291 : end if
1292 :
1293 : !---------------------------------
1294 : !Read pseudo valence density (if psp version >=4)
1295 231 : if (pspversion>=4) then
1296 90 : read (funit,*)
1297 90 : read (funit,*) iread1
1298 90 : ivalemesh=iread1
1299 90 : call pawrad_copy(radmesh(iread1),vale_mesh)
1300 270 : LIBPAW_POINTER_ALLOCATE(tnvale,(vale_mesh%mesh_size))
1301 90 : read (funit,*) (tnvale(ir),ir=1,vale_mesh%mesh_size)
1302 90 : pawtab%has_tvale=1
1303 : write(msg,'(a,i1)') &
1304 90 : & ' Radial grid used for pseudo valence density is grid ',ivalemesh
1305 90 : call wrtout(ab_out,msg,'COLL')
1306 90 : call wrtout(std_out, msg,'COLL')
1307 : else
1308 141 : pawtab%has_tvale=0
1309 141 : LIBPAW_POINTER_ALLOCATE(tnvale,(0))
1310 : end if
1311 :
1312 : !---------------------------------
1313 : !Initialize (to zero) kinetic energy and energy densities
1314 231 : pawtab%ekincore=zero
1315 231 : if (pawtab%has_coretau>0) then
1316 : write(msg,'(5a)' )&
1317 0 : & 'Kinetic energy density is requested but the core kinetic energy density',ch10,&
1318 0 : & 'is not present in the pseudopotential file!',ch10,&
1319 0 : & 'We assume that it is zero (for testing purpose).'
1320 0 : LIBPAW_WARNING(msg)
1321 0 : pawtab%coretau_mesh_size=pawtab%mesh_size
1322 0 : if(save_core_msz) pawtab%coretau_mesh_size=core_mesh%mesh_size
1323 0 : LIBPAW_ALLOCATE(pawtab%coretau,(pawtab%coretau_mesh_size))
1324 0 : LIBPAW_ALLOCATE(pawtab%tcoretau,(pawtab%coretau_mesh_size))
1325 0 : LIBPAW_POINTER_ALLOCATE(tcoretau,(core_mesh%mesh_size))
1326 0 : pawtab%rcoretau=core_mesh%rad(pawtab%coretau_mesh_size)
1327 0 : pawtab%coretau=zero ; pawtab%tcoretau=zero ; tcoretau=zero
1328 : endif
1329 :
1330 462 : end subroutine pawpsp_read
1331 : !!***
1332 :
1333 : !----------------------------------------------------------------------
1334 :
1335 : !!****f* m_pawpsp/pawpsp_init_core
1336 : !! NAME
1337 : !! pawpsp_init_core
1338 : !!
1339 : !! FUNCTION
1340 : !! Initialize a structure of type atomorb_type from a core file.
1341 : !!
1342 : !! INPUTS
1343 : !! psp_filename= (optional) Name of the file containing core electrons
1344 : !! rcut_in= (optional) Radius cut-off for radial mesh quantities
1345 : !! radmesh= (optional) Radial mesh
1346 : !!
1347 : !! OUTPUT
1348 : !! Atm<paw_atomorb_type>=Structure defining the set of core orbitals.
1349 : !!
1350 : !! SOURCE
1351 :
1352 10 : subroutine pawpsp_init_core(Atm,psp_filename,rcut_in,radmesh)
1353 : !Arguments ------------------------------------
1354 : !scalars
1355 : character(len=*), intent(in),optional :: psp_filename
1356 : real(dp), intent(in), optional :: rcut_in
1357 : type(atomorb_type),intent(inout) :: Atm
1358 : type(pawrad_type), intent(in),optional :: radmesh
1359 :
1360 : !Local variables-------------------------------
1361 : !scalars
1362 : integer :: unt,ios,fnln,ic
1363 : logical :: ex,fmt_xml,old_fmt,def_name,fmt_abinit
1364 : character(len=80) :: fline
1365 : character(len=500) :: msg
1366 : character(len=fnlen) :: filename_,string
1367 : real(dp) :: rcut
1368 :
1369 : ! ************************************************************************
1370 :
1371 10 : rcut=zero
1372 1 : if(present(rcut_in)) rcut=rcut_in
1373 10 : fmt_xml=.false.
1374 10 : old_fmt=.false.
1375 10 : def_name=.false.
1376 :
1377 10 : if (present(psp_filename)) then
1378 : ! Core WF file given as optional argument
1379 10 : filename_=trim(psp_filename)
1380 10 : fnln=len(trim(psp_filename))
1381 10 : fmt_abinit=.false.
1382 10 : if (fnln>6) fmt_abinit=(filename_(fnln-6:fnln)=='.abinit')
1383 10 : fmt_xml=.false.
1384 10 : if (fnln>3) fmt_xml=(filename_(fnln-3:fnln)=='.xml')
1385 10 : if(fmt_abinit) then
1386 0 : filename_=filename_(1:fnln-6)//'corewf.abinit'
1387 10 : elseif(fmt_xml) then
1388 7 : filename_=filename_(1:fnln-3)//'corewf.xml'
1389 : else
1390 3 : filename_=filename_(1:fnln)//'.corewf'
1391 : endif
1392 10 : inquire(file=trim(filename_),iostat=ios,exist=ex)
1393 10 : if (ios/=0) then
1394 0 : write(msg,'(2a)') 'INQUIRE returns an error for file ',trim(filename_)
1395 0 : LIBPAW_ERROR(msg)
1396 : end if
1397 10 : if (.not.ex) then
1398 1 : write(msg,'(3a)') 'This file does not exist: ',trim(filename_),'!'
1399 1 : LIBPAW_WARNING(msg)
1400 1 : string=trim(psp_filename)
1401 1 : filename_="CORE_"//trim(libpaw_basename(string))
1402 1 : ic = index (trim(string), "/" , back=.true.)
1403 1 : if (ic>0 .and. ic<len_trim(string)) filename_=psp_filename(1:ic)//trim(filename_)
1404 1 : inquire(file=trim(filename_),iostat=ios,exist=ex)
1405 1 : if (ios/=0) then
1406 0 : write(msg,'(2a)') 'INQUIRE returns an error for file ',trim(filename_)
1407 0 : LIBPAW_ERROR(msg)
1408 : end if
1409 1 : if (.not.ex) def_name=.true.
1410 : end if
1411 : endif
1412 :
1413 10 : if(.not.present(psp_filename).or.(def_name)) then
1414 : ! Core WF file: new format
1415 0 : filename_='corewf.abinit';ex=.false.
1416 0 : inquire(file=trim(filename_),iostat=ios,exist=ex)
1417 0 : if (ios/=0) then
1418 0 : write(msg,'(3a)') 'INQUIRE returns an error for file ',trim(filename_),'!'
1419 0 : LIBPAW_ERROR(msg)
1420 : end if
1421 0 : if (.not.ex) then
1422 : ! Core WF file: new format XML
1423 0 : filename_='corewf.xml';ex=.false.
1424 0 : inquire(file=trim(filename_),iostat=ios,exist=ex)
1425 0 : if (ios/=0) then
1426 0 : write(msg,'(3a)') 'INQUIRE returns an error for file ',trim(filename_),'!'
1427 0 : LIBPAW_ERROR(msg)
1428 : end if
1429 0 : fmt_xml=ex
1430 0 : if (.not.ex) then
1431 0 : write(msg, '(3a)' )'Please provide an up-to-date corewf file'
1432 0 : LIBPAW_ERROR(msg)
1433 : !! Core WF file: old format
1434 : ! filename_='corewf.dat';ex=.false.
1435 : ! inquire(file=trim(filename_),iostat=ios,exist=ex)
1436 : ! if (ios/=0) then
1437 : ! write(msg,'(3a)') 'INQUIRE returns an error for file ',trim(filename_),'!'
1438 : ! LIBPAW_ERROR(msg)
1439 : ! end if
1440 : ! old_fmt=ex
1441 : ! if (.not.ex) then
1442 : !! No core WF file found
1443 : ! write(msg, '(3a)' )&
1444 : !& 'Checks for existence of files corewf.abinit[.xml] or corewf.dat',ch10,&
1445 : !& 'but INQUIRE finds file does not exist!'
1446 : ! LIBPAW_ERROR(msg)
1447 : ! end if
1448 : end if
1449 : end if
1450 : write(msg, '(3a)' )&
1451 0 : 'Reading corewf file', trim(filename_),' : the calculation will NOT be &
1452 0 : & correct for several atomic types !'
1453 0 : LIBPAW_WARNING(msg)
1454 : endif
1455 :
1456 :
1457 :
1458 10 : unt = libpaw_get_free_unit()
1459 10 : open(unit=unt,file=trim(filename_),form='formatted',status='old',action="read")
1460 10 : read(unt,*) fline
1461 10 : close(unt)
1462 10 : fmt_xml=(fline(1:5)=='<?xml')
1463 :
1464 10 : if (fmt_xml) then
1465 7 : write(std_out,*) 'USING XML format'
1466 7 : if(present(radmesh)) then
1467 3 : write(std_out,*) 'Using input radial mesh to init atm'
1468 3 : call rdpawpsxml_core(Atm,trim(filename_),rcut,pawrad=radmesh)
1469 : else
1470 4 : call rdpawpsxml_core(Atm,trim(filename_),rcut)
1471 : endif
1472 : else
1473 3 : if(present(radmesh)) then
1474 2 : write(std_out,*) 'Using input radial mesh to init atm'
1475 2 : call pawpsp_read_corewf(Atm,trim(filename_),rcut,radmesh_in=radmesh)
1476 : else
1477 1 : call pawpsp_read_corewf(Atm,trim(filename_),rcut)
1478 : endif
1479 : endif
1480 :
1481 10 : end subroutine pawpsp_init_core
1482 : !!***
1483 :
1484 :
1485 : !-------------------------------------------------------------------------
1486 :
1487 : !!****f* m_pawpsp/pawpsp_read_corewf
1488 : !! NAME
1489 : !! pawpsp_read_corewf
1490 : !!
1491 : !! FUNCTION
1492 : !! Initialize a structure of type atomorb_type from a non-XML core file.
1493 : !!
1494 : !! INPUTS
1495 : !! filename_= core WF file name
1496 : !! oldformat= old format for the file or not
1497 : !! rcut= radius cut-off for radial mesh quantities
1498 : !! ramesh_in= (optional) radial mesh
1499 : !!
1500 : !! OUTPUT
1501 : !! Atm<paw_atomorb_type>= Structure defining the set of core orbitals.
1502 : !!
1503 : !! SIDE EFFECTS
1504 : !!
1505 : !! NOTES
1506 : !!
1507 : !! SOURCE
1508 3 : subroutine pawpsp_read_corewf(Atm,filename_,rcut,radmesh_in)
1509 :
1510 : !Arguments ------------------------------------
1511 : !scalars
1512 : character(len=*), intent(in) :: filename_
1513 : real(dp), intent(in) :: rcut
1514 : type(atomorb_type), intent(inout) :: Atm
1515 : type(pawrad_type), intent(in), optional :: radmesh_in
1516 :
1517 : !Local variables-------------------------------
1518 : !scalars
1519 : integer :: iln,imsh,ii,isppol,mt,ms,kk,dirac
1520 : integer :: il,ilmn,jl,jlmn,k0lmn,klmn
1521 : integer :: imainmesh,lmax,msz_cut,nmesh
1522 : integer :: pspcod,pspdat,unt
1523 : character(len=80) :: line
1524 : character(len=500) :: msg
1525 : real(dp) :: rs,ls,deriv1,deriv2
1526 3 : type(pawrad_type) :: tmpmesh
1527 : !arrays
1528 3 : integer,allocatable :: orbitals(:)
1529 3 : integer,allocatable :: meshtp(:),meshsz(:)
1530 3 : real(dp),allocatable :: radstp(:),logstp(:)
1531 3 : real(dp),allocatable :: phitmp(:),work(:)
1532 :
1533 : ! ************************************************************************
1534 :
1535 : ! Some default parameters
1536 3 : Atm%nspden=1
1537 3 : Atm%dirac=.false.
1538 3 : Atm%fname = filename_
1539 3 : Atm%l_max=0
1540 3 : Atm%l_size=0
1541 3 : Atm%ln_size=0
1542 3 : Atm%ln2_size=0
1543 3 : Atm%lmn_size=0
1544 3 : Atm%lmn2_size=0
1545 3 : Atm%mesh_size=0
1546 3 : Atm%mult=1
1547 3 : Atm%rcore=0.0_dp
1548 3 : atm%zcore_conv=.false.
1549 3 : atm%nc_conv=.false.
1550 3 : atm%nresid_c=one
1551 :
1552 :
1553 : !Core WF file is in (proprietary) format
1554 : ! if (.not.oldformat) then
1555 3 : unt = libpaw_get_free_unit()
1556 3 : open(unt,file=trim(filename_),form='formatted',action="read")
1557 : !1)
1558 3 : read(unt,*) !title
1559 : !2)
1560 3 : read(unt,err=23,end=23,fmt=*) dirac, Atm%method, Atm%nspinor, Atm%nsppol
1561 0 : write(msg,'(4(i2,2x),22x,a)' )dirac, Atm%method,Atm%nspinor,Atm%nsppol,' dirac, method, nspinor, nsppol.'
1562 0 : if(dirac==1) Atm%dirac=.true.
1563 3 : 23 backspace(unt)
1564 3 : read(unt,*) Atm%method, Atm%nspinor, Atm%nsppol
1565 3 : write(msg,'(3(i2,2x),22x,a)' )Atm%method,Atm%nspinor,Atm%nsppol,'method,nspinor, nsppol.'
1566 : go to 24
1567 : 24 continue
1568 3 : call wrtout(std_out,msg,'COLL')
1569 : !3)
1570 3 : read(unt,*) Atm%znucl, Atm%zcore, pspdat
1571 3 : Atm%zion=Atm%znucl-Atm%zcore
1572 3 : Atm%zcore_orig=Atm%zcore
1573 3 : write(msg,'(2f10.5,2x,i8,2x,a)' )Atm%znucl, Atm%zcore, pspdat,'znucl,zcore,pspdat'
1574 3 : call wrtout(std_out,msg,'COLL')
1575 3 : if(Atm%zcore==zero) then
1576 0 : LIBPAW_ALLOCATE(Atm%mode,(1,1,2))
1577 0 : Atm%mode = ORB_FROZEN
1578 : else
1579 : !4)
1580 3 : read(unt,*)pspcod,Atm%ixc,lmax
1581 3 : write(msg,'(2i5,2x,2x,a)')Atm%ixc,lmax,'ixc,lmax'
1582 3 : Atm%l_max = lmax+1
1583 : !5)
1584 3 : read(unt,*) ! skip pspfmt,creatorID
1585 : !6)
1586 3 : read(unt,*)Atm%ln_size, Atm%lmn_size
1587 : !7)
1588 9 : LIBPAW_ALLOCATE(orbitals,(Atm%ln_size))
1589 3 : read(unt,*) (orbitals(iln), iln=1,Atm%ln_size)
1590 12 : lmax = maxval(orbitals)
1591 3 : if (lmax+1/=Atm%l_max) then
1592 0 : write(msg,'(a)')" lmax read from file does not agree with orbitals. "
1593 0 : LIBPAW_ERROR(msg)
1594 : end if
1595 : !8)
1596 3 : read(unt,*)nmesh
1597 9 : LIBPAW_ALLOCATE(meshsz,(nmesh))
1598 6 : LIBPAW_ALLOCATE(meshtp,(nmesh))
1599 9 : LIBPAW_ALLOCATE(radstp,(nmesh))
1600 6 : LIBPAW_ALLOCATE(logstp,(nmesh))
1601 6 : do imsh=1,nmesh
1602 3 : ls=zero;read(unt,'(a80)') line
1603 3 : read(unit=line,fmt=*,err=20,end=20) ii,mt,ms,rs,ls
1604 : 20 continue
1605 6 : if (ii<=nmesh) then
1606 3 : meshtp(ii)=mt;meshsz(ii)=ms
1607 3 : radstp(ii)=rs;logstp(ii)=ls
1608 : end if
1609 : end do
1610 : !9)
1611 3 : read(unt,*) Atm%rcore
1612 : !10)
1613 9 : LIBPAW_ALLOCATE(Atm%indln,(2,Atm%ln_size))
1614 12 : LIBPAW_ALLOCATE(Atm%eig,(Atm%ln_size,Atm%nsppol))
1615 9 : LIBPAW_ALLOCATE(Atm%occ,(Atm%ln_size,Atm%nsppol))
1616 9 : LIBPAW_ALLOCATE(Atm%occ_res,(Atm%ln_size,Atm%nsppol))
1617 9 : LIBPAW_ALLOCATE(Atm%occ_respc,(Atm%ln_size,Atm%nsppol))
1618 3 : if (Atm%dirac) then
1619 0 : LIBPAW_ALLOCATE(Atm%kappa,(Atm%ln_size))
1620 : endif
1621 6 : do isppol=1,Atm%nsppol
1622 15 : do iln=1,Atm%ln_size
1623 9 : read(unt,*) ! skip comment
1624 9 : read(unt,*) ii
1625 9 : if (iln==1.and.isppol==1) then
1626 3 : imainmesh=ii
1627 3 : if(present(radmesh_in)) then
1628 2 : Atm%mesh_size = radmesh_in%mesh_size
1629 2 : Atm%rcore=radmesh_in%rad(radmesh_in%mesh_size)
1630 2 : call pawrad_copy(radmesh_in,atm%radmesh)
1631 1 : elseif(rcut>tol16) then
1632 1 : call pawrad_init(tmpmesh,meshsz(ii),meshtp(ii),radstp(ii),logstp(ii),-one)
1633 1 : msz_cut =min(pawrad_ifromr(tmpmesh,rcut)+6,tmpmesh%mesh_size) ! addsix more points
1634 1 : Atm%mesh_size = msz_cut
1635 1 : Atm%rcore = tmpmesh%rad(msz_cut)
1636 1 : call pawrad_init(Atm%radmesh,Atm%mesh_size,meshtp(ii),radstp(ii),logstp(ii),-one)
1637 1 : call pawrad_free(tmpmesh)
1638 : else
1639 0 : Atm%mesh_size= meshsz(ii)
1640 0 : call pawrad_init(Atm%radmesh,meshsz(ii),meshtp(ii),radstp(ii),logstp(ii),0d0)
1641 0 : Atm%rcore=Atm%radmesh%rad(Atm%mesh_size)
1642 : endif
1643 15 : LIBPAW_ALLOCATE(Atm%phi,(Atm%mesh_size,Atm%ln_size,Atm%nsppol))
1644 6 : else if ((ii/=imainmesh).and.(.not.present(radmesh_in))) then
1645 : write(msg,'(3a)')&
1646 0 : & ' All Phi core must be given on the same radial mesh !',ch10,&
1647 0 : & ' Action: check your pseudopotential file.'
1648 0 : ABI_ERROR(msg)
1649 : end if
1650 9 : read(unt,*) Atm%indln(2,iln),Atm%indln(1,iln),kk
1651 9 : read(unt,*) Atm%eig(iln,isppol),Atm%occ(iln,isppol)
1652 9 : Atm%eig(iln,isppol)=Atm%eig(iln,isppol)*half ! For consistency reasons (in the legacy coreWF format, energies are in Ry)
1653 9 : if(Atm%dirac) then
1654 0 : Atm%kappa(iln)=kk
1655 : endif
1656 : !11)
1657 27 : LIBPAW_ALLOCATE(phitmp,(meshsz(ii)))
1658 9 : read(unt,*) phitmp
1659 9 : if (present(radmesh_in)) then
1660 : if ((radmesh_in%mesh_type/=meshtp(ii)) &
1661 : & .or.(radmesh_in%rstep/=radstp(ii)) &
1662 6 : & .or.(radmesh_in%lstep/=logstp(ii))) then
1663 6 : call pawrad_init(tmpmesh,mesh_size=meshsz(ii),mesh_type=meshtp(ii),rstep=radstp(ii),lstep=logstp(ii))
1664 6 : ms=radmesh_in%mesh_size
1665 6 : if (tmpmesh%rmax<radmesh_in%rmax+tol8) ms=pawrad_ifromr(radmesh_in,tmpmesh%rmax)-1
1666 18 : LIBPAW_ALLOCATE(work,(meshsz(ii)))
1667 6 : call bound_deriv(phitmp,tmpmesh,meshsz(ii),deriv1,deriv2)
1668 6 : call paw_spline(tmpmesh%rad,phitmp,meshsz(ii),deriv1,deriv2,work)
1669 6 : call paw_splint(meshsz(ii),tmpmesh%rad,phitmp,work,ms,radmesh_in%rad(1:ms),Atm%phi(1:ms,iln,isppol))
1670 6 : if (ms<radmesh_in%mesh_size) Atm%phi(ms+1:radmesh_in%mesh_size,iln,isppol)=zero
1671 6 : LIBPAW_DEALLOCATE(work)
1672 12 : call pawrad_free(tmpmesh)
1673 : else
1674 0 : ms=min(meshsz(ii),radmesh_in%mesh_size)
1675 0 : Atm%phi(1:ms,iln,isppol)=phitmp(1:ms)
1676 0 : if (ms<radmesh_in%mesh_size) Atm%phi(ms+1:radmesh_in%mesh_size,iln,isppol)=zero
1677 : end if
1678 : else
1679 4149 : Atm%phi(:,iln,isppol) = phitmp(1:Atm%mesh_size)
1680 : endif
1681 12 : LIBPAW_DEALLOCATE(phitmp)
1682 : end do
1683 : enddo
1684 3 : LIBPAW_DEALLOCATE(meshsz)
1685 3 : LIBPAW_DEALLOCATE(meshtp)
1686 3 : LIBPAW_DEALLOCATE(radstp)
1687 3 : LIBPAW_DEALLOCATE(logstp)
1688 :
1689 3 : Atm%l_size =2*Atm%l_max-1
1690 3 : Atm%ln2_size = Atm%ln_size *(Atm%ln_size +1)/2
1691 3 : Atm%lmn2_size = Atm%lmn_size*(Atm%lmn_size+1)/2
1692 :
1693 3 : if(Atm%dirac) then
1694 0 : call make_indlmn(Atm%ln_size, Atm%lmn_size,orbitals,Atm%indlmn,kappa=Atm%kappa)
1695 : else
1696 3 : call make_indlmn(Atm%ln_size, Atm%lmn_size, orbitals, Atm%indlmn)
1697 : endif
1698 :
1699 : ! * Setup of indklmn and klm_diag.
1700 9 : LIBPAW_ALLOCATE(Atm%indklmn,(8,Atm%lmn2_size))
1701 9 : LIBPAW_ALLOCATE(Atm%klm_diag,(Atm%lmn2_size))
1702 3 : call make_indklmn(HUGE(1), Atm%lmn_size, Atm%lmn2_size, Atm%indlmn,Atm%indklmn, Atm%klm_diag)
1703 :
1704 : ! * Setup of klmntomn.
1705 9 : LIBPAW_ALLOCATE(Atm%klmntomn,(4,Atm%lmn2_size))
1706 18 : do jlmn=1,Atm%lmn_size
1707 15 : jl= Atm%indlmn(1,jlmn)
1708 15 : k0lmn=jlmn*(jlmn-1)/2
1709 63 : do ilmn=1,jlmn
1710 45 : il= Atm%indlmn(1,ilmn)
1711 45 : klmn=k0lmn+ilmn
1712 45 : Atm%klmntomn(1,klmn) = Atm%indlmn(2,ilmn)+il+1 ! im
1713 45 : Atm%klmntomn(2,klmn) = Atm%indlmn(2,jlmn)+jl+1 ! jm
1714 45 : Atm%klmntomn(3,klmn) = Atm%indlmn(3,ilmn) ! in
1715 60 : Atm%klmntomn(4,klmn) = Atm%indlmn(3,jlmn) ! jn
1716 : end do
1717 : end do
1718 :
1719 3 : LIBPAW_DEALLOCATE(orbitals)
1720 15 : LIBPAW_ALLOCATE(Atm%mode,(Atm%ln_size,Atm%nsppol,2))
1721 33 : Atm%mode = ORB_FROZEN
1722 12 : LIBPAW_ALLOCATE(Atm%max_occ,(Atm%ln_size,Atm%nsppol))
1723 18 : Atm%max_occ=Atm%occ
1724 :
1725 : ! * Setup of kln2ln.
1726 : !TODO this has to be tested
1727 : ! LIBPAW_ALLOCATE(Atm%kln2ln,(6,Atm%ln2_size))
1728 : ! call make_kln2ln(Atm%lmn_size,Atm%lmn2_size,Atm%ln2_size,Atm%indlmn,Atm%indklmn,Atm%kln2ln)
1729 :
1730 : endif
1731 3 : close(unt)
1732 : ! end if
1733 :
1734 : !!Core WF file is in old (proprietary) format
1735 : ! if(oldformat) then
1736 : ! unt = libpaw_get_free_unit()
1737 : ! open(unt,file=trim(filename_),form='formatted',action="read")
1738 : ! do while (dum/='atompaw ')
1739 : ! read(unt,'(a8)') dum
1740 : ! end do
1741 : ! read(unt,'(2i4)') Atm%mesh_size,Atm%ln_size
1742 : ! Atm%ln2_size = Atm%ln_size *(Atm%ln_size +1)/2
1743 : ! LIBPAW_ALLOCATE(Atm%indln,(2,Atm%ln_size))
1744 : ! LIBPAW_ALLOCATE(Atm%eig,(Atm%ln_size,1))
1745 : ! LIBPAW_ALLOCATE(Atm%phi,(Atm%mesh_size,Atm%ln_size,1))
1746 : ! LIBPAW_ALLOCATE(Atm%occ,(Atm%ln_size,1))
1747 : ! LIBPAW_ALLOCATE(rad,(Atm%mesh_size))
1748 : ! do iln=1,Atm%ln_size
1749 : ! read(unt,'(a4,i4,a3,i4,a6,f15.7,a8,f15.7)') &
1750 : !& dum1,Atm%indln(2,iln),dum2,Atm%indln(1,iln),dum3,Atm%occ(iln,1),Atm%eig(iln,1)
1751 : ! Atm%eig(iln,1)=Atm%eig(iln,1)*half ! For consistency reasons (in the legacy coreWF format, energies are in Ry)
1752 : ! do ims=1,Atm%mesh_size
1753 : ! read(unt,*) rad(ims),Atm%phi(ims,iln,1)
1754 : ! end do
1755 : ! read(unt,*)
1756 : ! end do
1757 : ! call pawrad_init(Atm%radmesh,mesh_size=Atm%mesh_size,mesh_type=1,rstep=rad(2)-rad(1),lstep=zero)
1758 : ! Atm%rcore=Atm%radmesh%rad(Atm%mesh_size)
1759 : ! LIBPAW_DEALLOCATE(rad)
1760 : ! close(unt)
1761 : ! end if
1762 :
1763 6 : end subroutine pawpsp_read_corewf
1764 : !!***
1765 :
1766 : !-------------------------------------------------------------------------
1767 :
1768 : !!****f* m_pawpsp/pawpsp_rw_atompaw
1769 : !! NAME
1770 : !! pawpsp_rw_atompaw
1771 : !!
1772 : !! FUNCTION
1773 : !!
1774 : !! INPUTS
1775 : !!
1776 : !! OUTPUT
1777 : !!
1778 : !! SIDE EFFECTS
1779 : !!
1780 : !! NOTES
1781 : !!
1782 : !! SOURCE
1783 :
1784 0 : subroutine pawpsp_rw_atompaw(basis_size,filpsp,wvl)
1785 :
1786 : !Arguments ------------------------------------
1787 : integer,intent(in):: basis_size
1788 : type(wvlpaw_type),intent(in)::wvl
1789 : character(len=fnlen),intent(in)::filpsp
1790 : !arrays
1791 : character(strlen) :: pspline
1792 : character(len=fnlen)::fname
1793 :
1794 : !Local variables-------------------------------
1795 : integer :: ib,ii,ios,jj,step,iunt,ount
1796 : !arrays
1797 :
1798 : ! *************************************************************************
1799 0 : iunt = libpaw_get_free_unit()
1800 0 : ount = libpaw_get_free_unit()
1801 :
1802 0 : step=0
1803 : ! Open psp file for reading
1804 0 : open(unit=iunt,file=trim(filpsp),form='formatted',status='old',action="read")
1805 : ! Open the file for writing
1806 0 : write(fname,'(2a)') libpaw_basename(trim(filpsp)),".wvl"
1807 0 : open(unit=ount,file=fname,form='formatted',status='unknown',action="write")
1808 :
1809 : read_loop: do
1810 0 : if(step==0) then
1811 0 : read(iunt,'(a)',IOSTAT=ios) pspline
1812 0 : if ( ios /= 0 ) exit read_loop
1813 : if(index(trim(pspline),'CORE_DENSITY')/=0 .and. &
1814 0 : & index(trim(pspline),'PSEUDO_CORE_DENSITY')==0 .and. &
1815 0 : & index(trim(pspline),'TCORE_DENSITY')==0 ) then
1816 : step=1
1817 : else
1818 0 : write(ount,'(a)') trim(pspline)
1819 : end if
1820 : elseif(step==1) then
1821 : !Write Gaussian projectors:
1822 0 : jj=0
1823 0 : do ib=1,basis_size
1824 0 : write(ount,'(a,i1,a)') "===== GAUSSIAN_TPROJECTOR ",ib,&
1825 0 : & " ===== "
1826 0 : write(ount,'(i5,1x,i5,1x,a)')wvl%pngau(ib),wvl%ptotgau, ":ngauss, total ngauss"
1827 0 : write(ount,'(3(1x,es23.16))')(wvl%parg(:,ii),&
1828 0 : & ii=jj+1,jj+wvl%pngau(ib))
1829 0 : write(ount,'(3(1x,es23.16))')(wvl%pfac(:,ii),&
1830 0 : & ii=jj+1,jj+wvl%pngau(ib))
1831 0 : jj=jj+wvl%pngau(ib)
1832 : end do
1833 0 : write(ount,'(a)') trim(pspline)
1834 0 : step=0
1835 : end if
1836 : end do read_loop
1837 :
1838 0 : close(iunt)
1839 0 : close(ount)
1840 :
1841 0 : end subroutine pawpsp_rw_atompaw
1842 : !!***
1843 :
1844 : !-------------------------------------------------------------------------
1845 :
1846 : !!****f* m_pawpsp/pawpsp_calc
1847 : !! NAME
1848 : !! pawpsp_calc
1849 : !!
1850 : !! FUNCTION
1851 : !! Performs tests and compute data related to pspcod=7 or 17 ("PAW pseudopotentials")
1852 : !!
1853 : !! INPUTS
1854 : !! core_mesh<type(pawrad_type)>= radial mesh for the core density
1855 : !! [coretau_mesh<type(pawrad_type)>]=radial mesh for the core kinetic energy density
1856 : !! imainmesh= serial number of the main mesh
1857 : !! ixc=exchange-correlation choice from main routine data file
1858 : !! lnmax=max. number of (l,n) components over all type of psps
1859 : !! angular momentum of nonlocal pseudopotential
1860 : !! mqgrid_ff=dimension of q (or G) grid for nl form factors (array ffspl)
1861 : !! mqgrid_vl=dimension of q (or G) grid for Vloc (array vlspl)
1862 : !! ncore(core_mesh%mesh_size)= core density
1863 : !! nmesh= number of radial meshes
1864 : !! pawrad <type(pawrad_type)>=paw radial mesh and related data
1865 : !! pawxcdev=choice of XC development (0=no dev. (use of angular mesh) ; 1 or 2=dev. on moments)
1866 : !! pspversion= version of the atompaw code used to generate paw data.
1867 : !! qgrid_ff(mqgrid_ff)=values of q on grid from 0 to qmax (bohr^-1) for nl form factors
1868 : !! qgrid_vl(mqgrid_vl)=values of q on grid from 0 to qmax (bohr^-1) for Vloc
1869 : !! radmesh(nmesh)<type(pawrad_type)>=paw radial meshes and related data
1870 : !! tncore(core_mesh%mesh_size)= pseudo core density
1871 : !! [tcoretau(coretau_mesh%mesh_size)]= pseudo core kinetic energy density
1872 : !! tproj(tproj_mesh%mesh_size)= non-local projectors in real space
1873 : !! tproj_mesh<type(pawrad_type)>= radial mesh for the projectors
1874 : !! usexcnhat=0 if compensation charge density is not included in XC terms
1875 : !! 1 if compensation charge density is included in XC terms
1876 : !! vale_mesh<type(pawrad_type)>= radial mesh for the valence density
1877 : !! xc_denpos= lowest allowed density (usually for the computation of the XC functionals)
1878 : !! [xc_taupos]= lowest allowed kinetic energy density (for mGGA XC functionals)
1879 : !! vlocopt= option for the local potential.(0=Vbare, 1=VH(tnzc) with hat in XC, 2=VH(tnzc) w/o hat in XC)
1880 : !! vlocr(vloc_mesh%mesh_size)= local potential according to vlocopt.
1881 : !! xclevel= XC functional level
1882 : !! zion=nominal valence of atom as specified in psp file
1883 : !! znucl=atomic number of atom as specified in input file to main routine
1884 : !! [el_temp]=electronic temperature (hartree)
1885 : !!
1886 : !! OUTPUT
1887 : !! epsatm=$ (4\pi)\int_0^\infty [r^2 (V(r)+\frac{Zv}{r}) dr]$(hartree)
1888 : !! ffspl(mqgrid_ff,2,lnmax)=form factor f_l(q) and second derivative
1889 : !! from spline fit for each angular momentum and each projector;
1890 : !! vlspl(mqgrid_vl,2)=q^2 Vloc(q) and second derivatives from spline fit
1891 : !! xcccrc=XC core correction cutoff radius (bohr) from psp file
1892 : !!
1893 : !! SIDE EFFECTS
1894 : !! pawtab <type(pawtab_type)>=paw tabulated starting data
1895 : !! tnvale(vale_mesh%mesh_size)= pseudo valence density (+ nhat in output)
1896 : !! vloc_mesh<type(pawrad_type)>= radial mesh for the local potential
1897 : !!
1898 : !! NOTES
1899 : !!
1900 : !!
1901 : !! SOURCE
1902 :
1903 1074 : subroutine pawpsp_calc(core_mesh,epsatm,ffspl,imainmesh,hyb_mixing,ixc,lnmax,&
1904 537 : & mmax,mqgrid_ff,mqgrid_vl,ncore,nmesh,pawrad,pawtab,pawxcdev,pspversion,&
1905 537 : & qgrid_ff,qgrid_vl,radmesh,tncore,tnvale,tproj,tproj_mesh,usexcnhat,vale_mesh,&
1906 537 : & vloc_mesh,vlocopt,vlocr,vlspl,xcccrc,xclevel,xc_denpos,zion,znucl,&
1907 537 : & tcoretau,coretau_mesh,xc_taupos,el_temp) !optional
1908 :
1909 : !Arguments ------------------------------------
1910 : !scalars
1911 : integer,intent(in) :: imainmesh,ixc,lnmax,mqgrid_ff,mqgrid_vl
1912 : integer,intent(in) :: nmesh,pawxcdev,pspversion,usexcnhat,vlocopt
1913 : integer,intent(in) ::mmax
1914 : integer,intent(in) :: xclevel
1915 : real(dp),intent(in) :: hyb_mixing,xc_denpos,zion,znucl
1916 : real(dp),intent(in),optional :: xc_taupos,el_temp
1917 : real(dp),intent(out) :: epsatm,xcccrc
1918 : type(pawrad_type),intent(in) :: core_mesh,tproj_mesh,vale_mesh
1919 : type(pawrad_type),intent(in),optional :: coretau_mesh
1920 : type(pawrad_type),intent(inout) ::pawrad,vloc_mesh
1921 : type(pawtab_type),intent(inout) :: pawtab
1922 : !arrays
1923 : real(dp),intent(in) :: ncore(core_mesh%mesh_size),tncore(core_mesh%mesh_size)
1924 : real(dp),intent(in),optional :: tcoretau(:)
1925 : real(dp),intent(in) :: qgrid_vl(mqgrid_vl),qgrid_ff(mqgrid_ff)
1926 : real(dp),intent(inout) :: ffspl(mqgrid_ff,2,lnmax)
1927 : real(dp),intent(out) :: vlspl(mqgrid_vl,2)
1928 : real(dp),intent(inout) :: tnvale(vale_mesh%mesh_size*pawtab%has_tvale)
1929 : real(dp),intent(inout) :: tproj(tproj_mesh%mesh_size,pawtab%basis_size)
1930 : real(dp),intent(inout) :: vlocr(vloc_mesh%mesh_size)
1931 : type(pawrad_type),intent(in) :: radmesh(nmesh)
1932 :
1933 : !Local variables ------------------------------
1934 : !scalars
1935 : integer,parameter :: reduced_mshsz=2501
1936 : integer :: ib,il,ilm,ilmn,iln,ir,isnotzero,itest
1937 : integer :: j0lmn,jlm,jlmn,jln,klmn,msz,msz1,msz_tmp,mst_tmp,nspden,usekden
1938 : logical :: has_dij0,non_magnetic_xc,reduced_ncor,reduced_taucor,reduced_nval,reduced_vloc,testval
1939 : real(dp),parameter :: reduced_rstep=0.00025_dp,rm_vloc=20.0_dp
1940 : real(dp) :: d2nvdq0,intg,intvh,lstep_tmp,my_xc_taupos,my_el_temp,qcore,qq,rstep_tmp,yp1,yp2,ypn
1941 : character(len=500) :: msg
1942 537 : type(pawang_type) :: pawang_tmp
1943 537 : type(pawrad_type) :: rcore_mesh,rcoretau_mesh,rvale_mesh,rvloc_mesh,tproj_mesh_new
1944 : !arrays
1945 : real(dp) :: tmp_qgrid(1),tmp_q2vq(1)
1946 537 : real(dp),allocatable :: ncorwk(:),nhat(:),nhatwk(:),nwk(:),r2k(:)
1947 537 : real(dp),allocatable :: rtncor(:),rttaucor(:),rtnval(:),rvlocr(:)
1948 537 : real(dp),allocatable :: vbare(:),vh(:),vhnzc(:),vxc1(:),vxc2(:)
1949 537 : real(dp),allocatable,target :: work1(:),work2(:),work3(:)
1950 537 : real(dp),pointer :: tmp1(:),tmp2(:)
1951 : logical :: tmp_lmselect(1)
1952 :
1953 : ! *************************************************************************
1954 :
1955 : !==========================================================
1956 : !Perfom tests on meshes
1957 :
1958 : !Are radial meshes for Phi and Vloc compatibles ?
1959 : ! if (vloc_mesh%rmax<pawrad%rmax) then
1960 : ! write(msg, '(a,a,a)' )&
1961 : !& 'Rmax for Vloc < Rmax !',ch10,&
1962 : !& 'Action : check your pseudopotential (increase Vloc meshSize).'
1963 : ! LIBPAW_ERROR(msg)
1964 : ! end if
1965 :
1966 : !Check optional arguments
1967 537 : my_el_temp=merge(el_temp,zero,present(el_temp))
1968 1074 : usekden=merge(0,1,pawtab%has_coretau==0)
1969 537 : my_xc_taupos=xc_denpos;if (present(xc_taupos)) my_xc_taupos=xc_taupos
1970 537 : if (present(tcoretau)) then
1971 14 : if (usekden>=1) then
1972 14 : if (.not.(present(coretau_mesh))) then
1973 0 : msg='tcoretau present but not coretau_mesh!'
1974 0 : LIBPAW_BUG(msg)
1975 : end if
1976 14 : if (size(tcoretau)>coretau_mesh%mesh_size) then
1977 0 : msg='wrong size for tcoretau!'
1978 0 : LIBPAW_BUG(msg)
1979 : end if
1980 14 : if (coretau_mesh%mesh_size<pawtab%mesh_size) then
1981 : write(msg, '(a,a,a,a,a)' )&
1982 0 : & 'Mesh size for core kinetic energy density must be equal or larger',ch10,&
1983 0 : & 'than mesh size for PAW augmentation regions !',ch10,&
1984 0 : & 'Action : check your pseudopotential (increase TAUcore meshSize).'
1985 0 : LIBPAW_ERROR(msg)
1986 : end if
1987 : end if
1988 : end if
1989 :
1990 : !Are mmax and mesh_size for partial waves compatibles ?
1991 537 : if (mmax/=pawtab%partialwave_mesh_size) then
1992 : write(msg, '(a,a,a)' )&
1993 0 : & 'mmax /= phi_mesh_size in psp file !',ch10,&
1994 0 : & 'Action: check your pseudopotential file.'
1995 0 : LIBPAW_ERROR(msg)
1996 : end if
1997 :
1998 : !Are radial meshes for (t)Ncore / tTAU and Phi compatibles ?
1999 537 : if (usekden>=1.and.core_mesh%mesh_size<pawtab%mesh_size) then
2000 : write(msg, '(a,a,a,a,a)' )&
2001 0 : & 'Mesh size for core density must be equal or larger',ch10,&
2002 0 : & 'than mesh size for PAW augmentation regions !',ch10,&
2003 0 : & 'Action : check your pseudopotential (increase Ncore meshSize).'
2004 0 : LIBPAW_ERROR(msg)
2005 : end if
2006 :
2007 : !Are radial meshes for (t)Nvale and Phi compatibles ?
2008 537 : if ((pawtab%has_tvale==1).and.(vale_mesh%rmax<pawrad%rmax)) then
2009 : write(msg, '(a,a,a)' )&
2010 0 : & 'Rmax for tNvale < Rmax for Phi !',ch10,&
2011 0 : & 'Action : check your pseudopotential (increase tNvale meshSize).'
2012 0 : LIBPAW_ERROR(msg)
2013 : end if
2014 :
2015 : !Is PAW radius included inside radial mesh ?
2016 537 : if (pawtab%rpaw>pawrad%rmax+tol8) then
2017 : write(msg, '(a,a,a)' )&
2018 0 : & 'Radius of PAW sphere is outside the radial mesh !',ch10,&
2019 0 : & 'Action: check your pseudopotential file.'
2020 0 : LIBPAW_ERROR(msg)
2021 : end if
2022 :
2023 : !Max. radius of mesh for Vloc has to be "small" in order to avoid numeric noise ?
2024 537 : if (vloc_mesh%rmax>rm_vloc) then
2025 271 : msz_tmp=pawrad_ifromr(vloc_mesh,rm_vloc);mst_tmp=vloc_mesh%mesh_type
2026 271 : rstep_tmp=vloc_mesh%rstep;lstep_tmp=vloc_mesh%lstep
2027 271 : call pawrad_free(vloc_mesh)
2028 : call pawrad_init(vloc_mesh,mesh_size=msz_tmp,mesh_type=mst_tmp,&
2029 271 : & rstep=rstep_tmp,lstep=lstep_tmp,r_for_intg=rm_vloc)
2030 271 : write(msg, '(a,i4,a)' ) ' Mesh size for Vloc has been set to ', &
2031 542 : & vloc_mesh%mesh_size,' to avoid numerical noise.'
2032 271 : call wrtout(std_out,msg,'COLL')
2033 271 : call wrtout(ab_out,msg,'COLL')
2034 : end if
2035 :
2036 : !This test has been disable... MT 2006-25-10
2037 : !For Simpson rule, it is better to have odd mesh sizes
2038 : !itest=0
2039 : !do imsh=1,nmesh
2040 : !if (mod(radmesh(imsh)%mesh_size,2)==0.and.radmesh(imsh)%mesh_type==1) itest=1
2041 : !end do
2042 : !if (itest==1) then
2043 : ! write(msg, '(5a)' ) &
2044 : !& 'Regular radial meshes should have odd number of points ',ch10,&
2045 : !& 'for better accuracy of integration sheme (Simpson rule).',ch10,&
2046 : !& 'Althought it''s not compulsory, you should change mesh sizes in psp file.'
2047 : ! LIBPAW_WARNING(msg)
2048 : !end if
2049 :
2050 : !Test the compatibilty between Rpaw and mesh for (t)Phi
2051 537 : if (pspversion>=3) then
2052 504 : itest=pawrad_ifromr(radmesh(imainmesh),pawtab%rpaw)
2053 : ! This test has been disable... MT 2015-02-12
2054 : ! if (itest+2>radmesh(imainmesh)%mesh_size) then
2055 : ! write(msg, '(9a)' ) &
2056 : !& 'Atomic data could produce inaccurate results:',ch10,&
2057 : !& 'Wavefunctions and pseudo-wavefunctions should',ch10,&
2058 : !& 'be given on a radial mesh larger than the PAW',ch10,&
2059 : !& 'spheres (at least 2 additional points) !',ch10,&
2060 : !& 'Action: check your pseudopotential file.'
2061 : ! LIBPAW_WARNING(msg)
2062 : ! end if
2063 504 : if (abs(pawtab%rpaw-radmesh(imainmesh)%rad(itest))<tol8) itest=itest-1
2064 504 : ib=0;isnotzero=0
2065 2823 : do while ((isnotzero==0).and.(ib<pawtab%basis_size))
2066 2319 : ib=ib+1;ir=itest
2067 15592 : do while ((isnotzero==0).and.(ir<pawtab%mesh_size))
2068 15088 : ir=ir+1;if (abs(pawtab%phi(ir,ib)-pawtab%tphi(ir,ib))>tol8) isnotzero=1
2069 : end do
2070 : end do
2071 504 : if (isnotzero>0) then
2072 : write(msg, '(7a)' )&
2073 0 : & 'Atomic data are inconsistent:',ch10,&
2074 0 : & 'For r>=r_paw, pseudo wavefunctions are not',ch10,&
2075 0 : & 'equal to wave functions (Phi(r)/=tPhi(r)) !',ch10,&
2076 0 : & 'Action: check your pseudopotential file.'
2077 0 : LIBPAW_ERROR(msg)
2078 : end if
2079 : else
2080 : ! For compatibility reasons set PAW radius at the end of mesh (older versions)
2081 33 : if (pawtab%rpaw/=pawrad%rmax) then
2082 33 : msz_tmp=pawrad%mesh_size;mst_tmp=pawrad%mesh_type
2083 33 : rstep_tmp=pawrad%rstep;lstep_tmp=pawrad%lstep
2084 33 : call pawrad_free(pawrad)
2085 33 : call pawrad_init(pawrad,mesh_size=msz_tmp,mesh_type=mst_tmp,rstep=rstep_tmp,lstep=lstep_tmp)
2086 33 : pawtab%rpaw=pawrad%rmax
2087 : end if
2088 : end if
2089 : !If Vloc is a "Vbare" potential, it has to be localized inside PAW spheres
2090 537 : if (vlocopt==0.and.(vloc_mesh%rmax>pawtab%rpaw+tol10)) then
2091 10 : if(vlocr(pawrad_ifromr(vloc_mesh,pawtab%rpaw))>tol10) then
2092 : write(msg, '(7a)' )&
2093 0 : & 'Atomic data are inconsistent:',ch10,&
2094 0 : & 'Local potential is a "Vbare" potential',ch10,&
2095 0 : & 'and is not localized inside PAW sphere !',ch10,&
2096 0 : & 'Vbare is set to zero if r>rpaw.'
2097 0 : LIBPAW_WARNING(msg)
2098 0 : do ir=pawrad_ifromr(vloc_mesh,pawtab%rpaw),vloc_mesh%mesh_size
2099 0 : vlocr(ir)=zero
2100 : end do
2101 : end if
2102 : end if
2103 :
2104 : !==========================================================
2105 : !Initializations
2106 :
2107 537 : has_dij0=(allocated(pawtab%dij0))
2108 :
2109 : !Allocate/initialize some dummy variables
2110 537 : tmp_lmselect(1)=.true.
2111 537 : non_magnetic_xc=.false.
2112 537 : if (pawxcdev==0) then
2113 43 : pawang_tmp%l_size_max=1;pawang_tmp%angl_size=1;pawang_tmp%ylm_size=1
2114 43 : pawang_tmp%use_ls_ylm=0;pawang_tmp%gnt_option=0;pawang_tmp%ngnt=0;pawang_tmp%nsym=0
2115 43 : LIBPAW_ALLOCATE(pawang_tmp%angwgth,(1))
2116 43 : pawang_tmp%angwgth(1)=one
2117 43 : LIBPAW_ALLOCATE(pawang_tmp%anginit,(3,1))
2118 43 : pawang_tmp%anginit(1,1)=one
2119 129 : pawang_tmp%anginit(2:3,1)=zero
2120 43 : LIBPAW_ALLOCATE(pawang_tmp%ylmr,(1,1))
2121 43 : pawang_tmp%ylmr(1,1)=1._dp/sqrt(four_pi)
2122 43 : LIBPAW_ALLOCATE(pawang_tmp%ylmrgr,(9,1,1))
2123 430 : pawang_tmp%ylmrgr(1:9,1,1)=zero
2124 : end if
2125 :
2126 : !==========================================================
2127 : !Compute ffspl(q) (and derivatives)
2128 :
2129 15356443 : ffspl=zero
2130 537 : if (mqgrid_ff>0) then
2131 : call pawpsp_nl(ffspl,pawtab%indlmn,pawtab%lmn_size,lnmax,mqgrid_ff,qgrid_ff,&
2132 537 : & tproj_mesh,tproj)
2133 : end if
2134 :
2135 : !==========================================================
2136 : !Compute eventually compensation charge radius (i.e. radius for shape functions)
2137 :
2138 537 : if (pawtab%shape_type>0.and.pawtab%rshp<1.d-8) then
2139 213 : pawtab%rshp=pawtab%rpaw
2140 324 : else if (pawtab%shape_type==-1) then
2141 3 : ir=pawrad_ifromr(radmesh(imainmesh),pawtab%rpaw)+1;isnotzero=0
2142 6 : do while ((isnotzero==0).and.(ir>1))
2143 3 : ir=ir-1;il=0
2144 6 : do while ((isnotzero==0).and.(il<pawtab%l_size))
2145 3 : il=il+1;if (pawtab%shapefunc(ir,il)>tol16) isnotzero=1
2146 : end do
2147 : end do
2148 3 : ir=min(ir+1,pawrad_ifromr(radmesh(imainmesh),pawtab%rpaw))
2149 3 : pawtab%rshp=radmesh(imainmesh)%rad(ir)
2150 18 : do il=1,pawtab%l_size
2151 18 : if (pawtab%shapefunc(ir,il)>tol6) then
2152 : write(msg, '(a,a,a)' )&
2153 0 : & 'Shape function is not zero at PAW radius !',ch10,&
2154 0 : & 'Action: check your pseudopotential file.'
2155 0 : LIBPAW_ERROR(msg)
2156 : end if
2157 : end do
2158 : end if
2159 :
2160 : !==========================================================
2161 : !Compute compensation charge density (nhat)
2162 : !Add it to pseudo valence density
2163 :
2164 537 : if (pawtab%has_tvale==1) then
2165 395 : msz=vale_mesh%mesh_size
2166 1185 : LIBPAW_ALLOCATE(nhat,(msz))
2167 : ! A-Has to compute norm of nhat (Int[n-tild_n])
2168 395 : testval=(abs(tnvale(msz))<tol9)
2169 : ! A1-If tnvale is not given with enough points,
2170 : ! try to compute it from rhoij0 and tphi
2171 395 : if (.not.testval) then
2172 60 : msz1=pawtab%mesh_size
2173 : ! Compute n and tild_n from phi and tphi
2174 180 : LIBPAW_ALLOCATE(work1,(msz1))
2175 120 : LIBPAW_ALLOCATE(work2,(msz1))
2176 40211 : work1=zero
2177 40211 : work2=zero
2178 768 : do jlmn=1,pawtab%lmn_size
2179 708 : j0lmn=jlmn*(jlmn-1)/2;jln=pawtab%indlmn(5,jlmn)
2180 6708 : do ilmn=1,jlmn
2181 5940 : klmn=j0lmn+ilmn;iln=pawtab%indlmn(5,ilmn)
2182 5940 : yp1=two;if (ilmn==jlmn) yp1=one
2183 : work1(1:msz1)=work1(1:msz1)+yp1*pawtab%rhoij0(klmn) &
2184 4888953 : & *pawtab% phi(1:msz1,iln)*pawtab% phi(1:msz1,jln)
2185 : work2(1:msz1)=work2(1:msz1)+yp1*pawtab%rhoij0(klmn) &
2186 4889661 : & *pawtab%tphi(1:msz1,iln)*pawtab%tphi(1:msz1,jln)
2187 : end do
2188 : end do
2189 : ! Spline tnvale onto pawrad if needed
2190 120 : LIBPAW_ALLOCATE(nwk,(msz1))
2191 60 : if ((vale_mesh%mesh_type/=pawrad%mesh_type).or.(vale_mesh%rstep/=pawrad%rstep).or.&
2192 : & (vale_mesh%lstep/=pawrad%lstep)) then
2193 0 : LIBPAW_ALLOCATE(work3,(vale_mesh%mesh_size))
2194 0 : call bound_deriv(tnvale(1:vale_mesh%mesh_size),vale_mesh,vale_mesh%mesh_size,yp1,ypn)
2195 0 : call paw_spline(vale_mesh%rad,tnvale,vale_mesh%mesh_size,yp1,ypn,work3)
2196 0 : call paw_splint(vale_mesh%mesh_size,vale_mesh%rad,tnvale,work3,msz1,pawrad%rad(1:msz1),nwk(1:msz1))
2197 0 : LIBPAW_DEALLOCATE(work3)
2198 : else
2199 40211 : nwk(1:msz1)=tnvale(1:msz1)
2200 : end if
2201 : ! Compare tild_n and tnvale (inside aug. region)
2202 40271 : if (maxval(abs((nwk(1:msz1)*four_pi*pawrad%rad(1:msz1)**2)-work2(1:msz1)))<tol6) then
2203 : ! If equality then compute Int[n-tild_n]
2204 36422 : work1=work1-work2
2205 52 : call simp_gen(qq,work1,pawrad)
2206 52 : qq=qq/four_pi
2207 : else
2208 : ! If not equality, will use tnvale
2209 8 : testval=.true.
2210 : write(msg, '(3a)' ) &
2211 8 : & 'Valence density is not given with enough points',ch10,&
2212 16 : & 'in psp file. Some charge estimations will be coarse.'
2213 8 : LIBPAW_WARNING(msg)
2214 : end if
2215 60 : LIBPAW_DEALLOCATE(nwk)
2216 60 : LIBPAW_DEALLOCATE(work1)
2217 60 : LIBPAW_DEALLOCATE(work2)
2218 : end if
2219 : ! A2-If tnvale is given with enough points, use it
2220 395 : if (testval) then
2221 584959 : nhat(1:msz)=tnvale(1:msz)*vale_mesh%rad(1:msz)**2
2222 343 : call simp_gen(qq,nhat,vale_mesh)
2223 343 : qq=zion/four_pi-qq
2224 : end if
2225 : ! B-Compute nhat and add it to pseudo valence density
2226 395 : call atompaw_shpfun(0,vale_mesh,intg,pawtab,nhat)
2227 627696 : nhat(1:msz)=qq*nhat(1:msz)
2228 627696 : tnvale(1:msz)=tnvale(1:msz)+nhat(1:msz)
2229 : end if
2230 :
2231 : !==========================================================
2232 : !If Vloc potential is in "Vbare" format, translate it into VH(tnzc) format
2233 :
2234 537 : if (vlocopt==0) then
2235 10 : write(msg,'(a)') ' Local potential is in "Vbare" format... '
2236 10 : call wrtout(ab_out,msg,'COLL')
2237 10 : call wrtout(std_out, msg,'COLL')
2238 10 : msz=core_mesh%mesh_size
2239 30 : LIBPAW_ALLOCATE(r2k,(msz))
2240 10 : call atompaw_shpfun(0,core_mesh,intg,pawtab,r2k)
2241 5078 : r2k(1:msz)=r2k(1:msz)*core_mesh%rad(1:msz)**2
2242 : ! Compute VH[4pi.r2.n(r)=4pi.r2.tncore(r)+(Qcore-Z).r2.k(r)]
2243 20 : LIBPAW_ALLOCATE(nwk,(core_mesh%mesh_size))
2244 20 : LIBPAW_ALLOCATE(vh,(core_mesh%mesh_size))
2245 10 : if (core_mesh%mesh_type==5) then
2246 902 : nwk(1:msz)=tncore(1:msz)*four_pi*core_mesh%rad(1:msz)**2
2247 2 : call simp_gen(qcore,nwk,core_mesh)
2248 2 : qcore=znucl-zion-qcore
2249 : else
2250 4176 : nwk(1:msz)=(ncore(1:msz)-tncore(1:msz))*four_pi*core_mesh%rad(1:msz)**2
2251 8 : ib=1
2252 4168 : do ir=msz,2,-1
2253 4168 : if(abs(nwk(ir))<tol14)ib=ir
2254 : end do
2255 8 : call simp_gen(qcore,nwk,core_mesh,r_for_intg=core_mesh%rad(ib))
2256 4176 : nwk(1:msz)=tncore(1:msz)*four_pi*core_mesh%rad(1:msz)**2
2257 : end if
2258 5078 : nwk(1:msz)=nwk(1:msz)+r2k(1:msz)*(qcore-znucl)
2259 10 : call poisson(nwk,0,core_mesh,vh)
2260 5068 : vh(2:msz)=vh(2:msz)/core_mesh%rad(2:msz)
2261 10 : call pawrad_deducer0(vh,msz,core_mesh)
2262 :
2263 10 : LIBPAW_DEALLOCATE(nwk)
2264 : ! Eventually spline Vbare
2265 20 : LIBPAW_ALLOCATE(vbare,(core_mesh%mesh_size))
2266 : if ((core_mesh%mesh_type/=vloc_mesh%mesh_type).or.&
2267 10 : & (core_mesh%rstep /=vloc_mesh%rstep) .or.&
2268 : & (core_mesh%lstep /=vloc_mesh%lstep)) then
2269 0 : msz=core_mesh%mesh_size;if (vloc_mesh%rmax<core_mesh%rmax) msz=pawrad_ifromr(core_mesh,vloc_mesh%rmax)
2270 0 : call bound_deriv(vlocr(1:vloc_mesh%mesh_size),vloc_mesh,vloc_mesh%mesh_size,yp1,ypn)
2271 0 : LIBPAW_ALLOCATE(work1,(vloc_mesh%mesh_size))
2272 0 : LIBPAW_ALLOCATE(work2,(vloc_mesh%mesh_size))
2273 0 : call paw_spline(vloc_mesh%rad,vlocr,vloc_mesh%mesh_size,yp1,ypn,work1)
2274 0 : call paw_splint(vloc_mesh%mesh_size,vloc_mesh%rad,vlocr,work1,msz,core_mesh%rad(1:msz),vbare)
2275 0 : LIBPAW_DEALLOCATE(work1)
2276 0 : LIBPAW_DEALLOCATE(work2)
2277 : else
2278 10 : msz=min(core_mesh%mesh_size,vloc_mesh%mesh_size)
2279 5062 : vbare(1:msz)=vlocr(1:msz)
2280 : end if
2281 : ! Build VH(tnzc) from Vbare
2282 5062 : vlocr(1:msz)=vbare(1:msz)+vh(1:msz)
2283 10 : if(vloc_mesh%mesh_size>msz)then
2284 392 : vlocr(msz+1:vloc_mesh%mesh_size)=vh(msz)*vloc_mesh%rad(msz)/vloc_mesh%rad(msz+1:vloc_mesh%mesh_size)
2285 : end if
2286 10 : LIBPAW_DEALLOCATE(vbare)
2287 10 : LIBPAW_DEALLOCATE(vh)
2288 :
2289 : ! Compute <tPhi_i|VH(tnzc)|tPhi_j> and int[VH(tnzc)*Qijhat(r)dr] parts of Dij0
2290 : ! Note: it is possible as core_mesh and radmesh(imainmesh) have the same steps
2291 10 : if (has_dij0) then
2292 0 : msz=radmesh(imainmesh)%mesh_size
2293 0 : LIBPAW_ALLOCATE(work1,(msz))
2294 0 : work1(1:msz)=vlocr(1:msz)*r2k(1:msz)
2295 0 : call simp_gen(intvh,work1,radmesh(imainmesh))
2296 0 : do jlmn=1,pawtab%lmn_size
2297 0 : j0lmn=jlmn*(jlmn-1)/2;jlm=pawtab%indlmn(4,jlmn);jln=pawtab%indlmn(5,jlmn)
2298 0 : do ilmn=1,jlmn
2299 0 : klmn=j0lmn+ilmn;ilm=pawtab%indlmn(4,ilmn);iln=pawtab%indlmn(5,ilmn)
2300 0 : if (jlm==ilm) then
2301 : work1(1:msz)=pawtab%tphi(1:msz,iln)*pawtab%tphi(1:msz,jln)*(vlocr(1:msz)-intvh) &
2302 0 : & -pawtab%phi (1:msz,iln)*pawtab%phi (1:msz,jln)*intvh
2303 0 : call simp_gen(intg,work1,radmesh(imainmesh))
2304 0 : pawtab%dij0(klmn)=pawtab%dij0(klmn)+intg
2305 : end if
2306 : end do
2307 : end do
2308 0 : LIBPAW_DEALLOCATE(work1)
2309 : end if
2310 10 : LIBPAW_DEALLOCATE(r2k)
2311 : end if
2312 :
2313 : !==========================================================
2314 : !If usexcnhat in psp file is different from usexcnhat chosen
2315 : !by user, convert VH(tnzc) and Dij0
2316 :
2317 537 : if (pawtab%usexcnhat==-1) then
2318 429 : pawtab%usexcnhat=usexcnhat
2319 108 : else if (usexcnhat/=pawtab%usexcnhat) then
2320 22 : if (pawtab%has_tvale==0) then
2321 : write(msg, '(5a)' ) &
2322 0 : & 'It is only possible to modify the use of compensation charge density',ch10,&
2323 0 : & 'for a file format containing the pseudo valence density (format>=paw4 or XML)!',ch10,&
2324 0 : & 'Action: use usexcnhat=-1 in input file or change psp file format.'
2325 0 : LIBPAW_ERROR(msg)
2326 22 : else if (usekden>=1) then
2327 : write(msg, '(5a)' ) &
2328 0 : & 'It is not possible to modify the use of compensation charge density',ch10,&
2329 0 : & 'within the metaGGA XC functional (need valence kinetic density)!',ch10,&
2330 0 : & 'Action: use usexcnhat=-1 in input file or change psp file format.'
2331 0 : LIBPAW_ERROR(msg)
2332 : else
2333 22 : msz=vloc_mesh%mesh_size
2334 : ! Retrieve tvale and nhat onto vloc mesh
2335 66 : LIBPAW_ALLOCATE(nwk,(msz))
2336 44 : LIBPAW_ALLOCATE(ncorwk,(msz))
2337 44 : LIBPAW_ALLOCATE(nhatwk,(msz))
2338 41800 : nwk=zero;ncorwk=zero;nhatwk=zero
2339 : if ((core_mesh%mesh_type/=vloc_mesh%mesh_type).or.&
2340 22 : & (core_mesh%rstep /=vloc_mesh%rstep) .or.&
2341 : & (core_mesh%lstep /=vloc_mesh%lstep)) then
2342 0 : LIBPAW_ALLOCATE(work1,(core_mesh%mesh_size))
2343 0 : msz1=msz;if (core_mesh%rmax<vloc_mesh%rmax) msz1=pawrad_ifromr(vloc_mesh,core_mesh%rmax)
2344 0 : call bound_deriv(tncore(1:core_mesh%mesh_size),core_mesh,core_mesh%mesh_size,yp1,ypn)
2345 0 : call paw_spline(core_mesh%rad,tncore,core_mesh%mesh_size,yp1,ypn,work1)
2346 0 : call paw_splint(core_mesh%mesh_size,core_mesh%rad,tncore,work1,msz1,vloc_mesh%rad(1:msz1),ncorwk(1:msz1))
2347 0 : LIBPAW_DEALLOCATE(work1)
2348 : else
2349 22 : msz1=min(core_mesh%mesh_size,msz)
2350 13052 : ncorwk(1:msz1)=tncore(1:msz1)
2351 : end if
2352 : if ((vale_mesh%mesh_type/=vloc_mesh%mesh_type).or.&
2353 22 : & (vale_mesh%rstep /=vloc_mesh%rstep) .or.&
2354 : & (vale_mesh%lstep /=vloc_mesh%lstep)) then
2355 0 : LIBPAW_ALLOCATE(work1,(vale_mesh%mesh_size))
2356 0 : msz1=msz;if (vale_mesh%rmax<vloc_mesh%rmax) msz1=pawrad_ifromr(vloc_mesh,vale_mesh%rmax)
2357 0 : call bound_deriv(tnvale(1:vale_mesh%mesh_size),vale_mesh,vale_mesh%mesh_size,yp1,ypn)
2358 0 : call paw_spline(vale_mesh%rad,tnvale,vale_mesh%mesh_size,yp1,ypn,work1)
2359 0 : call paw_splint(vale_mesh%mesh_size,vale_mesh%rad,tnvale,work1,msz1,vloc_mesh%rad(1:msz1),nwk(1:msz1))
2360 0 : call bound_deriv(nhat(1:vale_mesh%mesh_size),vale_mesh,vale_mesh%mesh_size,yp1,ypn)
2361 0 : call paw_spline(vale_mesh%rad,nhat,vale_mesh%mesh_size,yp1,ypn,work1)
2362 0 : call paw_splint(vale_mesh%mesh_size,vale_mesh%rad,nhat,work1,msz1,vloc_mesh%rad(1:msz1),nhatwk(1:msz1))
2363 0 : LIBPAW_DEALLOCATE(work1)
2364 : else
2365 22 : msz1=min(vale_mesh%mesh_size,msz)
2366 13948 : nwk (1:msz1)=tnvale(1:msz1)
2367 13948 : nhatwk(1:msz1)=nhat (1:msz1)
2368 : end if
2369 :
2370 13970 : nwk=nwk-nhatwk
2371 27874 : nwk=sqrt(four_pi)*nwk;nhatwk=sqrt(four_pi)*nhatwk ! 0th-order moment of densities
2372 :
2373 : ! Compute Vxc without nhat (vxc1) and with nhat (vxc2)
2374 22 : nspden=1
2375 : #if defined LIBPAW_HAVE_LIBXC
2376 22 : if (ixc<0) nspden=libxc_functionals_nspin()
2377 : #endif
2378 22 : if (ixc<0) then
2379 6 : LIBPAW_ALLOCATE(vxc1,(msz*nspden))
2380 4 : LIBPAW_ALLOCATE(vxc2,(msz*nspden))
2381 4 : LIBPAW_ALLOCATE(work1,(msz))
2382 4 : LIBPAW_ALLOCATE(work2,(msz*nspden))
2383 4 : LIBPAW_ALLOCATE(work3,(msz*nspden))
2384 2 : tmp1 => work1
2385 2666 : work2(1:msz)=nwk
2386 2666 : work3(1:msz)=nhatwk
2387 2666 : if (nspden==2) work2(msz+1:2*msz)=half*nwk
2388 2666 : if (nspden==2) work3(msz+1:2*msz)=half*nhatwk
2389 2 : if (pawxcdev/=0) then
2390 : call pawxcm(ncorwk,yp1,ypn,yp2,0,hyb_mixing,ixc,work1,1,tmp_lmselect,work3,0,non_magnetic_xc,msz,nspden,5,&
2391 2 : & pawang_tmp,vloc_mesh,pawxcdev,work2,pawtab%usetcore,0,vxc1,xclevel,xc_denpos,my_el_temp)
2392 : call pawxcm(ncorwk,yp1,ypn,yp2,0,hyb_mixing,ixc,work1,1,tmp_lmselect,work3,0,non_magnetic_xc,msz,nspden,5,&
2393 2 : & pawang_tmp,vloc_mesh,pawxcdev,work2,pawtab%usetcore,2,vxc2,xclevel,xc_denpos,my_el_temp)
2394 10658 : vxc1=vxc1/sqrt(four_pi);vxc2=vxc2/sqrt(four_pi) ! Deduce Vxc from its first moment
2395 : else
2396 : call pawxc(ncorwk,yp1,ypn,yp2,hyb_mixing,ixc,work1,tmp1,1,tmp_lmselect,work3,0,0,non_magnetic_xc,msz,nspden,5,&
2397 0 : & pawang_tmp,vloc_mesh,work2,pawtab%usetcore,0,vxc1,xclevel,xc_denpos,my_el_temp)
2398 : call pawxc(ncorwk,yp1,ypn,yp2,hyb_mixing,ixc,work1,tmp1,1,tmp_lmselect,work3,0,0,non_magnetic_xc,msz,nspden,5,&
2399 0 : & pawang_tmp,vloc_mesh,work2,pawtab%usetcore,2,vxc2,xclevel,xc_denpos,my_el_temp)
2400 : end if
2401 2 : LIBPAW_DEALLOCATE(nwk)
2402 2 : LIBPAW_DEALLOCATE(ncorwk)
2403 2 : LIBPAW_DEALLOCATE(nhatwk)
2404 2 : LIBPAW_DEALLOCATE(work1)
2405 2 : LIBPAW_DEALLOCATE(work2)
2406 2 : LIBPAW_DEALLOCATE(work3)
2407 : else
2408 40 : LIBPAW_ALLOCATE(vxc1,(msz))
2409 40 : LIBPAW_ALLOCATE(vxc2,(msz))
2410 40 : LIBPAW_ALLOCATE(work1,(msz))
2411 20 : tmp1 => work1
2412 20 : if (pawxcdev/=0) then
2413 : call pawxcm(ncorwk,yp1,ypn,yp2,0,hyb_mixing,ixc,work1,1,tmp_lmselect,nhatwk,0,non_magnetic_xc,msz,1,5,&
2414 20 : & pawang_tmp,vloc_mesh,pawxcdev,nwk,pawtab%usetcore,0,vxc1,xclevel,xc_denpos,my_el_temp)
2415 : call pawxcm(ncorwk,yp1,ypn,yp2,0,hyb_mixing,ixc,work1,1,tmp_lmselect,nhatwk,0,non_magnetic_xc,msz,1,5,&
2416 20 : & pawang_tmp,vloc_mesh,pawxcdev,nwk,pawtab%usetcore,2,vxc2,xclevel,xc_denpos,my_el_temp)
2417 22544 : vxc1=vxc1/sqrt(four_pi);vxc2=vxc2/sqrt(four_pi) ! Deduce Vxc from its first moment
2418 : else
2419 : call pawxc(ncorwk,yp1,ypn,yp2,hyb_mixing,ixc,work1,tmp1,1,tmp_lmselect,nhatwk,0,0,non_magnetic_xc,msz,1,5,&
2420 0 : & pawang_tmp,vloc_mesh,nwk,pawtab%usetcore,0,vxc1,xclevel,xc_denpos,my_el_temp)
2421 : call pawxc(ncorwk,yp1,ypn,yp2,hyb_mixing,ixc,work1,tmp1,1,tmp_lmselect,nhatwk,0,0,non_magnetic_xc,msz,1,5,&
2422 0 : & pawang_tmp,vloc_mesh,nwk,pawtab%usetcore,2,vxc2,xclevel,xc_denpos,my_el_temp)
2423 : end if
2424 20 : LIBPAW_DEALLOCATE(nwk)
2425 20 : LIBPAW_DEALLOCATE(ncorwk)
2426 20 : LIBPAW_DEALLOCATE(nhatwk)
2427 20 : LIBPAW_DEALLOCATE(work1)
2428 : endif
2429 : ! Compute difference of XC potentials
2430 9956 : if (usexcnhat==0.and.pawtab%usexcnhat/=0) vxc1(1:msz)=vxc2(1:msz)-vxc1(1:msz)
2431 4014 : if (usexcnhat/=0.and.pawtab%usexcnhat==0) vxc1(1:msz)=vxc1(1:msz)-vxc2(1:msz)
2432 : ! Modify VH(tnzc)
2433 13948 : vlocr(1:msz)=vlocr(1:msz)-vxc1(1:msz)
2434 22 : if (has_dij0) then
2435 : ! Modify Dij0
2436 51 : LIBPAW_ALLOCATE(work2,(pawtab%lmn2_size))
2437 : call atompaw_kij(pawtab%indlmn,work2,pawtab%lmn_size,ncore,0,0,pawtab,pawrad,&
2438 17 : & core_mesh,vloc_mesh,vxc1(1:msz),znucl)
2439 916 : pawtab%dij0=work2
2440 17 : LIBPAW_DEALLOCATE(work2)
2441 : end if
2442 22 : LIBPAW_DEALLOCATE(vxc1)
2443 22 : LIBPAW_DEALLOCATE(vxc2)
2444 : end if ! has_tvale/=0
2445 : end if
2446 537 : if (pawtab%usexcnhat==0) then
2447 : write(msg,'(a)') &
2448 316 : & ' Compensation charge density is not taken into account in XC energy/potential'
2449 316 : call wrtout(ab_out,msg,'COLL')
2450 316 : call wrtout(std_out, msg,'COLL')
2451 : end if
2452 537 : if (pawtab%usexcnhat==1) then
2453 : write(msg,'(a)') &
2454 221 : & ' Compensation charge density is taken into account in XC energy/potential'
2455 221 : call wrtout(ab_out,msg,'COLL')
2456 221 : call wrtout(std_out, msg,'COLL')
2457 : end if
2458 :
2459 : !==========================================================
2460 : ! Calculate the coefficient beta = \int { vH[nZc](r) - vloc(r) } 4pi r^2 dr
2461 : !
2462 1611 : LIBPAW_ALLOCATE(vhnzc,(core_mesh%mesh_size))
2463 1074 : LIBPAW_ALLOCATE(nwk,(core_mesh%mesh_size))
2464 : ! get vH[nZc]
2465 537 : call atompaw_vhnzc(ncore,core_mesh,vhnzc,znucl)
2466 :
2467 : !Transpose vlocr mesh into core mesh
2468 675973 : nwk(:)=zero
2469 : if ((core_mesh%mesh_type/=vloc_mesh%mesh_type).or.&
2470 537 : & (core_mesh%rstep /=vloc_mesh%rstep) .or.&
2471 : & (core_mesh%lstep /=vloc_mesh%lstep)) then
2472 0 : msz=core_mesh%mesh_size;if (vloc_mesh%rmax<core_mesh%rmax) msz=pawrad_ifromr(core_mesh,vloc_mesh%rmax)
2473 0 : call bound_deriv(vlocr(1:vloc_mesh%mesh_size),vloc_mesh,vloc_mesh%mesh_size,yp1,ypn)
2474 0 : LIBPAW_ALLOCATE(work1,(vloc_mesh%mesh_size))
2475 0 : LIBPAW_ALLOCATE(work2,(vloc_mesh%mesh_size))
2476 0 : call paw_spline(vloc_mesh%rad,vlocr,vloc_mesh%mesh_size,yp1,ypn,work1)
2477 0 : call paw_splint(vloc_mesh%mesh_size,vloc_mesh%rad,vlocr,work1,msz,core_mesh%rad(1:msz),nwk)
2478 0 : LIBPAW_DEALLOCATE(work1)
2479 0 : LIBPAW_DEALLOCATE(work2)
2480 : else
2481 537 : msz=min(core_mesh%mesh_size,vloc_mesh%mesh_size)
2482 618658 : nwk(1:msz)=vlocr(1:msz)
2483 : end if
2484 :
2485 : !Difference
2486 618658 : nwk(1:msz)=vhnzc(1:msz)-nwk(1:msz)
2487 57852 : if (msz<core_mesh%mesh_size) nwk(msz+1:core_mesh%mesh_size)=zero
2488 :
2489 : !Perform the spherical integration
2490 618658 : nwk(1:msz)=nwk(1:msz)*four_pi*core_mesh%rad(1:msz)**2
2491 :
2492 537 : call simp_gen(pawtab%beta,nwk,core_mesh)
2493 :
2494 537 : LIBPAW_DEALLOCATE(vhnzc)
2495 537 : LIBPAW_DEALLOCATE(nwk)
2496 :
2497 : write(msg,'(a,e18.6)') &
2498 537 : & ' beta integral value: ',pawtab%beta
2499 537 : call wrtout(std_out,msg,'COLL')
2500 :
2501 :
2502 : !==========================================================
2503 : !Try to optimize CPU time:
2504 : !If Vloc mesh size is big, spline Vloc into a smaller log. mesh
2505 :
2506 537 : reduced_vloc=(vloc_mesh%mesh_size>int(reduced_mshsz))
2507 537 : if (reduced_vloc) then
2508 11 : msz=vloc_mesh%mesh_size
2509 11 : lstep_tmp=log(0.9999999_dp*vloc_mesh%rmax/reduced_rstep)/dble(reduced_mshsz-2)
2510 : call pawrad_init(rvloc_mesh,mesh_size=reduced_mshsz,mesh_type=3,&
2511 11 : & rstep=reduced_rstep,lstep=lstep_tmp)
2512 11 : LIBPAW_ALLOCATE(rvlocr,(reduced_mshsz))
2513 11 : call bound_deriv(vlocr(1:msz),vloc_mesh,msz,yp1,ypn)
2514 33 : LIBPAW_ALLOCATE(work1,(msz))
2515 22 : LIBPAW_ALLOCATE(work2,(msz))
2516 22 : LIBPAW_ALLOCATE(work3,(msz))
2517 48161 : work3(1:msz)=vloc_mesh%rad(1:msz)
2518 11 : call paw_spline(work3,vlocr,msz,yp1,ypn,work1)
2519 11 : call paw_splint(msz,work3,vlocr,work1,reduced_mshsz,rvloc_mesh%rad,rvlocr)
2520 11 : LIBPAW_DEALLOCATE(work1)
2521 11 : LIBPAW_DEALLOCATE(work2)
2522 11 : LIBPAW_DEALLOCATE(work3)
2523 : end if
2524 :
2525 : !Keep VH(tnZc) eventually in memory
2526 537 : if (pawtab%has_vhtnzc==1) then
2527 : if ((reduced_vloc).and.(rvloc_mesh%mesh_type==pawrad%mesh_type)&
2528 537 : & .and.(rvloc_mesh%rstep==pawrad%rstep).and.(rvloc_mesh%lstep==pawrad%lstep)) then
2529 0 : LIBPAW_ALLOCATE(pawtab%vhtnzc,(rvloc_mesh%mesh_size))
2530 0 : pawtab%vhtnzc(:)=rvlocr(:)
2531 0 : pawtab%has_vhtnzc=2
2532 : else if ((vloc_mesh%mesh_type==pawrad%mesh_type)&
2533 537 : & .and.(vloc_mesh%rstep==pawrad%rstep).and.(vloc_mesh%lstep==pawrad%lstep)) then
2534 1611 : LIBPAW_ALLOCATE(pawtab%vhtnzc,(size(vlocr)))
2535 733407 : pawtab%vhtnzc(:)=vlocr(:)
2536 537 : pawtab%has_vhtnzc=2
2537 : else
2538 0 : msg = 'Vloc mesh is not right !'
2539 0 : LIBPAW_ERROR(msg)
2540 : end if
2541 : end if
2542 :
2543 : !==========================================================
2544 : !Try to optimize CPU time:
2545 : !If ncore mesh size is big, spline tncore into a smaller log. mesh
2546 :
2547 537 : reduced_ncor=(core_mesh%mesh_size>int(reduced_mshsz)).and.(pawtab%usetcore/=0)
2548 : if (reduced_ncor) then
2549 0 : msz=core_mesh%mesh_size
2550 0 : lstep_tmp=log(0.9999999_dp*core_mesh%rmax/reduced_rstep)/dble(reduced_mshsz-2)
2551 : call pawrad_init(rcore_mesh,mesh_size=reduced_mshsz,mesh_type=3,&
2552 0 : & rstep=reduced_rstep,lstep=lstep_tmp)
2553 0 : LIBPAW_ALLOCATE(rtncor,(reduced_mshsz))
2554 0 : call bound_deriv(tncore(1:msz),core_mesh,msz,yp1,ypn)
2555 0 : LIBPAW_ALLOCATE(work1,(msz))
2556 0 : LIBPAW_ALLOCATE(work2,(msz))
2557 0 : LIBPAW_ALLOCATE(work3,(msz))
2558 0 : work3(1:msz)=core_mesh%rad(1:msz)
2559 0 : call paw_spline(work3,tncore,msz,yp1,ypn,work1)
2560 0 : call paw_splint(msz,work3,tncore,work1,reduced_mshsz,rcore_mesh%rad,rtncor)
2561 0 : LIBPAW_DEALLOCATE(work1)
2562 0 : LIBPAW_DEALLOCATE(work2)
2563 0 : LIBPAW_DEALLOCATE(work3)
2564 : end if
2565 :
2566 : !==========================================================
2567 : !Try to optimize CPU time:
2568 : !If coretau mesh size is big, spline tcoretau into a smaller log. mesh
2569 :
2570 537 : reduced_taucor=.false.
2571 537 : if (usekden>=1.and.present(tcoretau)) then
2572 14 : reduced_taucor=(coretau_mesh%mesh_size>int(reduced_mshsz)).and.(pawtab%usetcore/=0)
2573 : if (reduced_taucor) then
2574 0 : msz=coretau_mesh%mesh_size
2575 0 : lstep_tmp=log(0.9999999_dp*coretau_mesh%rmax/reduced_rstep)/dble(reduced_mshsz-2)
2576 : call pawrad_init(rcoretau_mesh,mesh_size=reduced_mshsz,mesh_type=3,&
2577 0 : & rstep=reduced_rstep,lstep=lstep_tmp)
2578 0 : LIBPAW_ALLOCATE(rttaucor,(reduced_mshsz))
2579 0 : call bound_deriv(tcoretau(1:msz),coretau_mesh,msz,yp1,ypn)
2580 0 : LIBPAW_ALLOCATE(work1,(msz))
2581 0 : LIBPAW_ALLOCATE(work2,(msz))
2582 0 : LIBPAW_ALLOCATE(work3,(msz))
2583 0 : work3(1:msz)=coretau_mesh%rad(1:msz)
2584 0 : call paw_spline(work3,tcoretau,msz,yp1,ypn,work1)
2585 0 : call paw_splint(msz,work3,tcoretau,work1,reduced_mshsz,rcoretau_mesh%rad,rttaucor)
2586 0 : LIBPAW_DEALLOCATE(work1)
2587 0 : LIBPAW_DEALLOCATE(work2)
2588 0 : LIBPAW_DEALLOCATE(work3)
2589 : end if
2590 : end if
2591 :
2592 : !==========================================================
2593 : !Try to optimize CPU time:
2594 : !If vale mesh size is big, spline tnvale into a smaller log. mesh
2595 :
2596 537 : if (pawtab%has_tvale==1) then
2597 395 : reduced_nval=(vale_mesh%mesh_size>int(reduced_mshsz))
2598 395 : if (reduced_nval) then
2599 7 : msz=vale_mesh%mesh_size
2600 7 : lstep_tmp=log(0.9999999_dp*vale_mesh%rmax/reduced_rstep)/dble(reduced_mshsz-2)
2601 : call pawrad_init(rvale_mesh,mesh_size=reduced_mshsz,mesh_type=3,&
2602 7 : & rstep=reduced_rstep,lstep=lstep_tmp)
2603 7 : LIBPAW_ALLOCATE(rtnval,(reduced_mshsz))
2604 7 : call bound_deriv(tnvale(1:msz),vale_mesh,msz,yp1,ypn)
2605 21 : LIBPAW_ALLOCATE(work1,(msz))
2606 14 : LIBPAW_ALLOCATE(work2,(msz))
2607 14 : LIBPAW_ALLOCATE(work3,(msz))
2608 41877 : work3(1:msz)=vale_mesh%rad(1:msz)
2609 7 : call paw_spline(work3,tnvale,msz,yp1,ypn,work1)
2610 7 : call paw_splint(msz,work3,tnvale,work1,reduced_mshsz,rvale_mesh%rad,rtnval)
2611 7 : LIBPAW_DEALLOCATE(work1)
2612 7 : LIBPAW_DEALLOCATE(work2)
2613 7 : LIBPAW_DEALLOCATE(work3)
2614 : end if
2615 : else
2616 : reduced_nval=.false.
2617 : end if
2618 : !==========================================================
2619 : !Compute Vlspl(q) (and second derivative) from Vloc(r)
2620 :
2621 : !Compute Vlspl(q)=q^2.Vloc(q) from vloc(r)
2622 537 : if(mqgrid_vl>0) then
2623 537 : if (reduced_vloc) then
2624 11 : call pawpsp_lo(epsatm,mqgrid_vl,qgrid_vl,vlspl(:,1),rvloc_mesh,rvlocr,yp1,ypn,zion)
2625 : else
2626 526 : call pawpsp_lo(epsatm,mqgrid_vl,qgrid_vl,vlspl(:,1),vloc_mesh,vlocr,yp1,ypn,zion)
2627 : end if
2628 : ! Compute second derivative of Vlspl(q)
2629 537 : call paw_spline(qgrid_vl,vlspl(:,1),mqgrid_vl,yp1,ypn,vlspl(:,2))
2630 : else
2631 : ! Only to compute epsatm
2632 : epsatm=zero
2633 0 : if (reduced_vloc) then
2634 0 : call pawpsp_lo(epsatm,1,tmp_qgrid,tmp_q2vq,rvloc_mesh,rvlocr,yp1,ypn,zion)
2635 : else
2636 0 : call pawpsp_lo(epsatm,1,tmp_qgrid,tmp_q2vq,vloc_mesh,vlocr,yp1,ypn,zion)
2637 : end if
2638 : end if
2639 : !==========================================================
2640 : !Compute tcorespl(q) (and second derivative) from tNcore(r)
2641 :
2642 537 : pawtab%mqgrid=mqgrid_vl
2643 537 : xcccrc=core_mesh%rmax
2644 1611 : LIBPAW_ALLOCATE(pawtab%tcorespl,(pawtab%mqgrid,2))
2645 :
2646 537 : if(mqgrid_vl>0.and.pawtab%usetcore/=0) then
2647 : ! Compute tcorespl(q)=tNc(q) from tNcore(r)
2648 392 : if (reduced_ncor) then
2649 0 : call pawpsp_cg(pawtab%dncdq0,pawtab%d2ncdq0,mqgrid_vl,qgrid_vl,pawtab%tcorespl(:,1),rcore_mesh,rtncor,yp1,ypn)
2650 : else
2651 392 : call pawpsp_cg(pawtab%dncdq0,pawtab%d2ncdq0,mqgrid_vl,qgrid_vl,pawtab%tcorespl(:,1),core_mesh,tncore,yp1,ypn)
2652 : end if
2653 : ! Compute second derivative of tcorespl(q)
2654 392 : call paw_spline(qgrid_vl,pawtab%tcorespl(:,1),mqgrid_vl,yp1,ypn,pawtab%tcorespl(:,2))
2655 : else
2656 922073 : pawtab%tcorespl=zero
2657 145 : pawtab%dncdq0=zero
2658 145 : pawtab%d2ncdq0=zero
2659 : end if
2660 :
2661 : !==========================================================
2662 : !Compute tcoretauspl(q)
2663 :
2664 537 : if (present(tcoretau)) then
2665 70 : LIBPAW_ALLOCATE(pawtab%tcoretauspl,(pawtab%mqgrid,2*usekden))
2666 14 : if (usekden==1) then
2667 14 : if (coretau_mesh%rmax/=xcccrc) then
2668 : write(msg, '(a,a,a)' )&
2669 0 : & 'Core density and core kinetic density should be given on the same grid!',ch10,&
2670 0 : & 'Action : check your pseudopotential (increase tNvale meshSize).'
2671 0 : LIBPAW_ERROR(msg)
2672 : end if
2673 14 : if(mqgrid_vl>0) then
2674 : ! Compute tcorespl(q)=tNc(q) from tNcore(r)
2675 14 : if (reduced_taucor) then
2676 0 : call pawpsp_cg(pawtab%dtaucdq0,qq,mqgrid_vl,qgrid_vl,pawtab%tcoretauspl(:,1),rcoretau_mesh,rttaucor,yp1,ypn)
2677 : else
2678 14 : call pawpsp_cg(pawtab%dtaucdq0,qq,mqgrid_vl,qgrid_vl,pawtab%tcoretauspl(:,1),coretau_mesh,tcoretau,yp1,ypn)
2679 : end if
2680 : ! Compute second derivative of tcorespl(q)
2681 14 : call paw_spline(qgrid_vl,pawtab%tcoretauspl(:,1),mqgrid_vl,yp1,ypn,pawtab%tcoretauspl(:,2))
2682 : else
2683 0 : pawtab%tcoretauspl=zero
2684 0 : pawtab%dtaucdq0=zero
2685 : end if
2686 : end if
2687 : end if
2688 :
2689 : !==========================================================
2690 : !Compute tvalespl(q) (and second derivative) from tNvale(r)
2691 :
2692 537 : if (pawtab%has_tvale/=0.and.mqgrid_vl>0) then
2693 1185 : LIBPAW_ALLOCATE(pawtab%tvalespl,(pawtab%mqgrid,2))
2694 395 : if (reduced_nval) then
2695 7 : call pawpsp_cg(pawtab%dnvdq0,d2nvdq0,mqgrid_vl,qgrid_vl,pawtab%tvalespl(:,1),rvale_mesh,rtnval,yp1,ypn)
2696 7 : pawtab%tnvale_mesh_size=rvale_mesh%mesh_size
2697 : else
2698 388 : call pawpsp_cg(pawtab%dnvdq0,d2nvdq0,mqgrid_vl,qgrid_vl,pawtab%tvalespl(:,1),vale_mesh,tnvale,yp1,ypn)
2699 388 : pawtab%tnvale_mesh_size=vale_mesh%mesh_size
2700 : end if
2701 : ! Compute second derivative of tvalespl(q)
2702 395 : call paw_spline(qgrid_vl,pawtab%tvalespl(:,1),mqgrid_vl,yp1,ypn,pawtab%tvalespl(:,2))
2703 : else
2704 142 : pawtab%dnvdq0=zero
2705 142 : pawtab%tnvale_mesh_size=0
2706 : end if
2707 :
2708 : !==================================================
2709 : !Compute Ex-correlation energy for the core density
2710 :
2711 537 : nspden=1
2712 : #if defined LIBPAW_HAVE_LIBXC
2713 537 : if (ixc<0) nspden=libxc_functionals_nspin()
2714 : #endif
2715 :
2716 1611 : LIBPAW_ALLOCATE(work1,(core_mesh%mesh_size*nspden))
2717 1074 : LIBPAW_ALLOCATE(work2,(core_mesh%mesh_size))
2718 537 : LIBPAW_ALLOCATE(work3,(1))
2719 1420501 : work1(:)=zero;work2(:)=zero;work3(:)=zero
2720 537 : tmp1 => work1 ; tmp2 => work1
2721 :
2722 537 : if (pawxcdev/=0) then
2723 : call pawxcm(ncore,pawtab%exccore,yp1,pawtab%sxccore,0,hyb_mixing,ixc,work2,1,tmp_lmselect,work3,0,non_magnetic_xc,core_mesh%mesh_size,&
2724 494 : & nspden,4,pawang_tmp,core_mesh,pawxcdev,work1,1,0,tmp1,xclevel,xc_denpos,my_el_temp)
2725 : else
2726 43 : if (present(tcoretau)) then
2727 : call pawxc(ncore,pawtab%exccore,yp1,pawtab%sxccore,hyb_mixing,ixc,work2,work1,1,tmp_lmselect,work3,0,0,non_magnetic_xc,core_mesh%mesh_size,&
2728 14 : & nspden,4,pawang_tmp,core_mesh,tmp1,1,0,tmp2,xclevel,xc_denpos,my_el_temp,coretau=tcoretau,xc_taupos=my_xc_taupos)
2729 : else
2730 : call pawxc(ncore,pawtab%exccore,yp1,pawtab%sxccore,hyb_mixing,ixc,work2,work1,1,tmp_lmselect,work3,0,0,non_magnetic_xc,core_mesh%mesh_size,&
2731 29 : & nspden,4,pawang_tmp,core_mesh,tmp1,1,0,tmp2,xclevel,xc_denpos,my_el_temp)
2732 : end if
2733 : end if
2734 :
2735 537 : LIBPAW_DEALLOCATE(work1)
2736 537 : LIBPAW_DEALLOCATE(work2)
2737 537 : LIBPAW_DEALLOCATE(work3)
2738 :
2739 : !==================================================
2740 : !Compute Hartree kinetic energy for the core density and the nucleus
2741 :
2742 537 : call atompaw_ehnzc(ncore,core_mesh,pawtab%ehnzc,znucl)
2743 :
2744 : !==================================================
2745 : !Compute atomic contribution to Dij (Dij0)
2746 : !if not already in memory
2747 :
2748 537 : if ((.not.has_dij0).and.(pawtab%has_kij==2.or.pawtab%has_kij==-1)) then
2749 30 : LIBPAW_ALLOCATE(pawtab%dij0,(pawtab%lmn2_size))
2750 10 : if (reduced_vloc) then
2751 : call atompaw_dij0(pawtab%indlmn,pawtab%kij,pawtab%lmn_size,ncore,0,pawtab,pawrad,core_mesh,&
2752 0 : & rvloc_mesh,rvlocr,znucl)
2753 : else
2754 : call atompaw_dij0(pawtab%indlmn,pawtab%kij,pawtab%lmn_size,ncore,0,pawtab,pawrad,core_mesh,&
2755 10 : & vloc_mesh,vlocr,znucl)
2756 : end if
2757 : has_dij0=.true.
2758 : end if
2759 : !==================================================
2760 : !Compute kinetic operator contribution to Dij
2761 :
2762 537 : if (pawtab%has_kij==1.and.has_dij0) then
2763 15 : LIBPAW_ALLOCATE(pawtab%kij,(pawtab%lmn2_size))
2764 : call atompaw_kij(pawtab%indlmn,pawtab%kij,pawtab%lmn_size,ncore,0,1,pawtab,pawrad,core_mesh,&
2765 5 : & vloc_mesh,vlocr,znucl)
2766 5 : pawtab%has_kij=2
2767 : end if
2768 :
2769 : !pawtab%has_kij=-1 means that kij does not have to be kept in memory
2770 537 : if (pawtab%has_kij==-1) then
2771 10 : LIBPAW_DEALLOCATE(pawtab%kij)
2772 10 : pawtab%has_kij=0
2773 : end if
2774 :
2775 : !==========================================================
2776 : !If projectors have to be kept in memory, we need
2777 : !them on the main radial mesh (so, spline them if necessary)
2778 :
2779 537 : if (pawtab%has_tproj>0) then
2780 : if ((tproj_mesh%mesh_type/=pawrad%mesh_type).or.&
2781 3 : & (tproj_mesh%rstep /=pawrad%rstep).or.&
2782 : & (tproj_mesh%lstep /=pawrad%lstep)) then
2783 0 : ir=pawrad_ifromr(pawrad,tproj_mesh%rmax)
2784 : call pawrad_init(tproj_mesh_new,mesh_size=ir,mesh_type=pawrad%mesh_type,&
2785 0 : & rstep=pawrad%rstep,lstep=pawrad%lstep)
2786 0 : LIBPAW_ALLOCATE(pawtab%tproj,(tproj_mesh_new%mesh_size,pawtab%basis_size))
2787 0 : LIBPAW_ALLOCATE(work1,(tproj_mesh%mesh_size))
2788 0 : do ib=1,pawtab%basis_size
2789 0 : call bound_deriv(tproj(:,ib),tproj_mesh,tproj_mesh%mesh_size,yp1,ypn)
2790 0 : call paw_spline(tproj_mesh%rad,tproj(:,ib),tproj_mesh%mesh_size,yp1,ypn,work1)
2791 : call paw_splint(tproj_mesh%mesh_size,tproj_mesh%rad,tproj(:,ib),work1,&
2792 0 : & tproj_mesh_new%mesh_size,tproj_mesh_new%rad,pawtab%tproj(:,ib))
2793 : end do
2794 0 : LIBPAW_DEALLOCATE(work1)
2795 0 : call pawrad_free(tproj_mesh_new)
2796 : else
2797 12 : LIBPAW_ALLOCATE(pawtab%tproj,(tproj_mesh%mesh_size,pawtab%basis_size))
2798 60063 : pawtab%tproj(:,:)=tproj(:,:)
2799 : end if
2800 3 : pawtab%has_tproj=2
2801 : end if
2802 :
2803 : !==========================================================
2804 : !Free temporary allocated space
2805 :
2806 537 : if (pawtab%has_tvale==1) then
2807 395 : LIBPAW_DEALLOCATE(nhat)
2808 : end if
2809 537 : if (reduced_vloc) then
2810 11 : call pawrad_free(rvloc_mesh)
2811 11 : LIBPAW_DEALLOCATE(rvlocr)
2812 : end if
2813 537 : if (reduced_ncor) then
2814 0 : call pawrad_free(rcore_mesh)
2815 0 : LIBPAW_DEALLOCATE(rtncor)
2816 : end if
2817 537 : if (reduced_taucor) then
2818 0 : call pawrad_free(rcoretau_mesh)
2819 0 : LIBPAW_DEALLOCATE(rttaucor)
2820 : end if
2821 537 : if (reduced_nval) then
2822 7 : call pawrad_free(rvale_mesh)
2823 7 : LIBPAW_DEALLOCATE(rtnval)
2824 : end if
2825 537 : if (pawxcdev==0) then
2826 43 : LIBPAW_DEALLOCATE(pawang_tmp%angwgth)
2827 43 : LIBPAW_DEALLOCATE(pawang_tmp%anginit)
2828 43 : LIBPAW_DEALLOCATE(pawang_tmp%ylmr)
2829 43 : LIBPAW_DEALLOCATE(pawang_tmp%ylmrgr)
2830 : end if
2831 :
2832 1074 : end subroutine pawpsp_calc
2833 : !!***
2834 :
2835 : !-------------------------------------------------------------------------
2836 :
2837 : !!****f* m_pawpsp/pawpsp_calc_d5
2838 : !! NAME
2839 : !! pawpsp_calc_d5
2840 : !!
2841 : !! FUNCTION
2842 : !! Compute the first to the 5th derivatives of
2843 : !! a given function in a pawrad mesh
2844 : !!
2845 : !! INPUTS
2846 : !!
2847 : !! OUTPUT
2848 : !!
2849 : !! SIDE EFFECTS
2850 : !!
2851 : !! NOTES
2852 : !!
2853 : !! SOURCE
2854 :
2855 0 : subroutine pawpsp_calc_d5(mesh,mesh_size,tcoredens)
2856 :
2857 : !Arguments ------------------------------------
2858 : integer,intent(in) :: mesh_size
2859 : type(pawrad_type),intent(in) :: mesh
2860 : real(dp),intent(inout) :: tcoredens(mesh_size,6)
2861 :
2862 : !Local variables-------------------------------
2863 : integer,parameter :: it=1 !number of steps for smoothing function
2864 : logical,parameter :: use_smooth=.true.
2865 :
2866 : ! *************************************************************************
2867 :
2868 : !calculate first derivative from density,
2869 : !and store it
2870 0 : call nderiv_gen(tcoredens(:,2),tcoredens(:,1),mesh)
2871 :
2872 : !get second derivative from density, and store it
2873 : call paw_spline(mesh%rad,tcoredens(:,1),mesh_size,&
2874 0 : & zero,zero,tcoredens(:,3))
2875 :
2876 : !smooth functions, to avoid numerical instabilities
2877 : if(use_smooth) then
2878 0 : call paw_smooth(tcoredens(:,2),mesh_size,it)
2879 0 : call paw_smooth(tcoredens(:,3),mesh_size,it)
2880 : end if
2881 :
2882 : !get third derivative from first derivative:
2883 : call paw_spline(mesh%rad,tcoredens(:,2),mesh_size,&
2884 0 : & zero,zero,tcoredens(:,4))
2885 :
2886 : !get fourth derivative from second derivative:
2887 : call paw_spline(mesh%rad,tcoredens(:,3),mesh_size,&
2888 0 : & zero,zero,tcoredens(:,5))
2889 :
2890 : !smooth 3rd and 4th order derivatives
2891 : if(use_smooth) then
2892 0 : call paw_smooth(tcoredens(:,4),mesh_size,it)
2893 0 : call paw_smooth(tcoredens(:,5),mesh_size,it)
2894 : end if
2895 :
2896 : !get fifth derivative from third derivative:
2897 : call paw_spline(mesh%rad,tcoredens(:,4),mesh_size,&
2898 0 : & zero,zero,tcoredens(:,6))
2899 :
2900 : !smooth 5th order derivative
2901 : if(use_smooth) then
2902 0 : call paw_smooth(tcoredens(:,6),mesh_size,it)
2903 : end if
2904 :
2905 0 : end subroutine pawpsp_calc_d5
2906 : !!***
2907 :
2908 : !-------------------------------------------------------------------------
2909 :
2910 : !!****f* m_pawpsp/pawpsp_vhar2rho
2911 : !! NAME
2912 : !! pawpsp_vhar2rho
2913 : !!
2914 : !! FUNCTION
2915 : !! gets rho(r) from v(r), solving the Poisson equation
2916 : !! \lap v(r) = 4 \pi rho(r)
2917 : !!
2918 : !! INPUTS
2919 : !! radmesh = radial grid (datastructure)
2920 : !! vv(:)= potential
2921 : !!
2922 : !! OUTPUT
2923 : !! rho(:)= density
2924 : !!
2925 : !! SIDE EFFECTS
2926 : !!
2927 : !! NOTES
2928 : !!
2929 : !! SOURCE
2930 :
2931 0 : subroutine pawpsp_vhar2rho(radmesh,rho,vv)
2932 :
2933 : !Arguments ------------------------------------
2934 : type(pawrad_type),intent(in) :: radmesh
2935 : real(dp), intent(in) :: vv(:)
2936 : real(dp), intent(out):: rho(:)
2937 :
2938 : !Local variables-------------------------------
2939 : integer :: nr
2940 0 : real(dp) :: dfdr(radmesh%mesh_size),d2fdr(radmesh%mesh_size)
2941 :
2942 : ! *************************************************************************
2943 :
2944 0 : nr=size(vv)
2945 0 : if (nr/=size(rho)) then
2946 0 : LIBPAW_BUG('wrong sizes!')
2947 : end if
2948 :
2949 : !Laplacian =
2950 : !\frac{\partial^2}{\partial r^2} + 2/r \frac{\partial}{\partial r}
2951 :
2952 : !Calculate derivatives
2953 0 : call nderiv_gen(dfdr(1:nr),vv,radmesh,der2=d2fdr(1:nr))
2954 :
2955 0 : rho(2:nr)=d2fdr(2:nr) + 2._dp*dfdr(2:nr)/radmesh%rad(2:nr)
2956 0 : call pawrad_deducer0(rho,nr,radmesh)
2957 :
2958 0 : rho(1:nr)=-rho(1:nr)/(4._dp*pi)
2959 :
2960 0 : end subroutine pawpsp_vhar2rho
2961 : !!***
2962 :
2963 : !-------------------------------------------------------------------------
2964 :
2965 : !!****f* m_pawpsp/pawpsp_wvl_calc
2966 : !! NAME
2967 : !! pawpsp_wvl_calc
2968 : !!
2969 : !! FUNCTION
2970 : !! Performs tests and compute data related to pspcod=7 or 17 ("PAW pseudopotentials")
2971 : !!
2972 : !! INPUTS
2973 : !! tnvale(vale_mesh%mesh_size)= pseudo valence density (+ nhat in output)
2974 : !! usewvl= flag for wavelets method
2975 : !! vale_mesh<type(pawrad_type)>= radial mesh for the valence density
2976 : !! vloc_mesh<type(pawrad_type)>= radial mesh for the local potential
2977 : !! vlocr(vloc_mesh%mesh_size)= local potential according to vlocopt.
2978 : !!
2979 : !! OUTPUT
2980 : !! Sets pawtab%rholoc
2981 : !!
2982 : !! SIDE EFFECTS
2983 : !! pawtab <type(pawtab_type)>= objects are modified
2984 : !!
2985 : !! NOTES
2986 : !!
2987 : !! SOURCE
2988 :
2989 0 : subroutine pawpsp_wvl_calc(pawtab,tnvale,usewvl,vale_mesh,vloc_mesh,vlocr)
2990 :
2991 : !Arguments ------------------------------------
2992 : !scalars
2993 : integer,intent(in)::usewvl
2994 : type(pawrad_type),intent(in) :: vale_mesh
2995 : type(pawtab_type),intent(inout) :: pawtab
2996 : type(pawrad_type),intent(in) ::vloc_mesh
2997 :
2998 : !arrays
2999 : real(dp),intent(in) :: tnvale(vale_mesh%mesh_size*pawtab%has_tvale)
3000 : real(dp),intent(in) :: vlocr(vloc_mesh%mesh_size)
3001 :
3002 :
3003 : !Local variables ------------------------------
3004 : !scalars
3005 : integer :: msz
3006 : character(len=500) :: msg
3007 : !arrays
3008 :
3009 : ! *************************************************************************
3010 :
3011 : !If usewvl flag is on, we must have the pawtab%wvl pointer allocated
3012 0 : if (pawtab%has_wvl==0) then
3013 0 : msg='pawtab%has_wvl flag should be on o entry'
3014 0 : LIBPAW_BUG(msg)
3015 : end if
3016 0 : call wvlpaw_allocate(pawtab%wvl)
3017 :
3018 : !==========================================================
3019 : !Change mesh_size of tvalespl
3020 : !Compute second derivative from tNvale(r)
3021 :
3022 0 : if (pawtab%has_tvale/=0) then
3023 0 : if(usewvl==1) then
3024 0 : if(allocated(pawtab%tvalespl)) then
3025 0 : LIBPAW_DEALLOCATE(pawtab%tvalespl)
3026 : end if
3027 0 : LIBPAW_ALLOCATE(pawtab%tvalespl,(vale_mesh%mesh_size,2))
3028 0 : pawtab%tnvale_mesh_size=vale_mesh%mesh_size
3029 0 : pawtab%tvalespl(:,1)=tnvale
3030 : ! Compute second derivative of tvalespl(r)
3031 0 : call paw_spline(vale_mesh%rad,pawtab%tvalespl(:,1),vale_mesh%mesh_size,zero,zero,pawtab%tvalespl(:,2))
3032 : end if
3033 : else
3034 0 : pawtab%dnvdq0=zero
3035 0 : pawtab%tnvale_mesh_size=0
3036 : end if
3037 :
3038 : !==========================================================
3039 : !Save rholoc:
3040 : !Get local density from local potential
3041 : !use the poisson eq.
3042 0 : msz=vloc_mesh%mesh_size
3043 0 : call wvlpaw_rholoc_free(pawtab%wvl%rholoc)
3044 0 : LIBPAW_ALLOCATE(pawtab%wvl%rholoc%d,(msz,4))
3045 0 : LIBPAW_ALLOCATE(pawtab%wvl%rholoc%rad,(msz))
3046 0 : pawtab%wvl%rholoc%msz=msz
3047 0 : pawtab%wvl%rholoc%rad(1:msz)=vloc_mesh%rad(1:msz)
3048 :
3049 : !get rho from v:
3050 0 : call pawpsp_vhar2rho(vloc_mesh,pawtab%wvl%rholoc%d(:,1),vlocr)
3051 : !
3052 : !get second derivative, and store it
3053 : call paw_spline(pawtab%wvl%rholoc%rad,pawtab%wvl%rholoc%d(:,1),pawtab%wvl%rholoc%msz,&
3054 0 : & zero,zero,pawtab%wvl%rholoc%d(:,2))
3055 :
3056 : !save also vlocr:
3057 0 : pawtab%wvl%rholoc%d(:,3)=vlocr
3058 :
3059 : !get second derivative, and store it
3060 : call paw_spline(pawtab%wvl%rholoc%rad,vlocr,pawtab%wvl%rholoc%msz,&
3061 0 : & zero,zero,pawtab%wvl%rholoc%d(:,4))
3062 :
3063 : !Test
3064 : !do ii=1,pawtab%wvl%rholoc%msz
3065 : !write(503,'(3(f16.10,x))')pawtab%wvl%rholoc%rad(ii),pawtab%wvl%rholoc%d(ii,1),pawtab%wvl%rholoc%d(ii,3)
3066 : !end do
3067 : !
3068 : !Do splint
3069 : !
3070 : !nmesh=4000
3071 : !rread1= (9.9979999d0/real(nmesh-1,dp)) ! 0.0025001d0 !step
3072 : !allocate(raux1(nmesh),raux2(nmesh))
3073 : !do ii=1,nmesh
3074 : !raux1(ii)=rread1*real(ii-1,dp) !mesh
3075 : !end do
3076 : !call splint(pawtab%wvl%rholoc%msz,pawtab%wvl%rholoc%rad,pawtab%wvl%rholoc%d(:,1),pawtab%wvl%rholoc%d(:,2),&
3077 : !& nmesh,raux1,raux2,ierr)
3078 : !do ii=1,nmesh
3079 : !write(401,'(10(f20.7,x))')raux1(ii),raux2(ii),raux2(ii)*raux1(ii)**2
3080 : !end do
3081 : !deallocate(raux1,raux2)
3082 :
3083 0 : end subroutine pawpsp_wvl_calc
3084 : !!***
3085 :
3086 : !-------------------------------------------------------------------------
3087 :
3088 : !!****f* m_pawpsp/pawpsp_17in
3089 : !! NAME
3090 : !! pawpsp_17in
3091 : !!
3092 : !! FUNCTION
3093 : !! Initialize pspcod=17 ("PAW XML pseudopotentials"):
3094 : !! continue to read the corresponding file and compute the form factors
3095 : !!
3096 : !! INPUTS
3097 : !! ipsp= id in the array of the currently read pseudo.
3098 : !! ixc=exchange-correlation choice from main routine data file
3099 : !! lmax=value of lmax mentioned at the second line of the psp file
3100 : !! lnmax=max. number of (l,n) components over all type of psps
3101 : !! angular momentum of nonlocal pseudopotential
3102 : !! mmax=max number of pts in real space grid (already read in the psp file header)
3103 : !! mqgrid_ff=dimension of q (or G) grid for nl form factors (array ffspl)
3104 : !! mqgrid_vl=dimension of q (or G) grid for Vloc (array vlspl)
3105 : !! pawxcdev=choice of XC development (0=no dev. (use of angular mesh) ; 1 or 2=dev. on moments)
3106 : !! pspheads= header of the current pseudopotential
3107 : !! qgrid_ff(psps%mqgrid_ff)=values of q on grid from 0 to qmax (bohr^-1) for nl form factors
3108 : !! qgrid_vl(psps%mqgrid_vl)=values of q on grid from 0 to qmax (bohr^-1) for Vloc
3109 : !! xclevel= XC functional level
3110 : !! xc_denpos= lowest allowed density (usually for the computation of the XC functionals)
3111 : !! [xc_taupos]= lowest allowed kinetic energy density (for mGGA XC functionals)
3112 : !! [el_temp]=electronic temperature (hartree)
3113 : !! zion=nominal valence of atom as specified in psp file
3114 : !! znucl=atomic number of atom as specified in input file to main routine
3115 : !!
3116 : !! OUTPUT
3117 : !! epsatm=$ (4\pi)\int_0^\infty [r^2 (V(r)+\frac{Zv}{r}) dr]$(hartree)
3118 : !! ffspl(psps%mqgrid_ff,2,psps%lnmax)=form factor f_l(q) and second derivative
3119 : !! from spline fit for each angular momentum and each projector;
3120 : !! pawrad <type(pawrad_type)>=paw radial mesh and related data
3121 : !! pawtab <type(pawtab_type)>=paw tabulated starting data
3122 : !! vlspl(psps%mqgrid_vl,2)=q^2 Vloc(q) and second derivatives from spline fit
3123 : !! wvl_crmult,wvl_frmult= variables definining the fine and coarse grids in a wavelets calculation
3124 : !! xcccrc=XC core correction cutoff radius (bohr) from psp file
3125 : !!
3126 : !! NOTES
3127 : !! Spin-orbit not yet implemented (to be done)
3128 : !! Comments:
3129 : !! * mesh_type= type of radial mesh
3130 : !! mesh_type=1 (regular grid): rad(i)=(i-1)*AA
3131 : !! mesh_type=2 (logari. grid): rad(i)=AA*(exp[BB*(i-1)]-1)
3132 : !! mesh_type=3 (logari. grid): rad(i>1)=AA*exp[BB*(i-2)] and rad(1)=0
3133 : !! mesh_type=4 (logari. grid): rad(i)=-AA*ln[1-BB*(i-1)] with BB=1/n
3134 : !! * radial shapefunction type
3135 : !! shape_type=-1 ; gl(r)=numeric (read from psp file)
3136 : !! shape_type= 1 ; gl(r)=k(r).r^l; k(r)=exp[-(r/sigma)**lambda]
3137 : !! shape_type= 2 ; gl(r)=k(r).r^l; k(r)=[sin(pi*r/rshp)/(pi*r/rshp)]**2 if r<=rshp
3138 : !! shape_type= 3 ; gl(r)=Alpha(1,l)*jl(q(1,l)*r)+Alpha(2,l)*jl(q(2,l)*r) for each l
3139 : !!
3140 : !! SOURCE
3141 :
3142 306 : subroutine pawpsp_17in(epsatm,ffspl,icoulomb,ipsp,hyb_mixing,ixc,lmax,&
3143 : & lnmax,mmax,mqgrid_ff,mqgrid_vl,pawpsp_header,pawrad,pawtab,&
3144 306 : & pawxcdev, qgrid_ff,qgrid_vl,usewvl,usexcnhat_in,vlspl,xcccrc,&
3145 : & xclevel,xc_denpos,zion,znucl,&
3146 : & xc_taupos,el_temp) ! Optional argument
3147 :
3148 : !Arguments ------------------------------------
3149 : !scalars
3150 : integer,intent(in) :: ipsp,ixc,lmax,lnmax,mqgrid_ff,mqgrid_vl,pawxcdev,usexcnhat_in
3151 : integer,intent(inout) ::mmax
3152 : integer,intent(in) :: xclevel,icoulomb,usewvl
3153 : real(dp),intent(in) :: hyb_mixing,xc_denpos,zion,znucl
3154 : real(dp),intent(in),optional :: xc_taupos,el_temp
3155 : real(dp),intent(out) :: epsatm,xcccrc
3156 : type(pawpsp_header_type),intent(in) :: pawpsp_header
3157 : type(pawrad_type),intent(inout) :: pawrad
3158 : type(pawtab_type),intent(inout) :: pawtab
3159 : !arrays
3160 : real(dp),intent(in) :: qgrid_ff(mqgrid_ff),qgrid_vl(mqgrid_vl)
3161 : real(dp),intent(inout) :: ffspl(mqgrid_ff,2,lnmax)
3162 : real(dp),intent(out) :: vlspl(mqgrid_vl,2)
3163 :
3164 : !Local variables ------------------------------
3165 : !scalars
3166 : integer :: has_v_minushalf,ib,icoremesh,icoretaumesh,il,ilm,ilmn,ilmn0,iln,imainmesh,imsh,iprojmesh
3167 : integer :: ir,iread1,ishpfmesh,ivalemesh,ivlocmesh,j0lmn,jlm,pngau
3168 : integer :: jlmn,jln,klmn,msz,nmesh,nval,pspversion,shft,sz10,usexcnhat,vlocopt
3169 : real(dp), parameter :: rmax_vloc=10.0_dp
3170 : real(dp) :: fourpi,my_xc_taupos,my_el_temp,occ,rc,yp1,ypn
3171 : logical :: save_core_msz
3172 : character(len=500) :: msg
3173 306 : type(pawrad_type) :: core_mesh,coretau_mesh,shpf_mesh,tproj_mesh,vale_mesh,vloc_mesh
3174 : !arrays
3175 306 : integer,allocatable :: mesh_shift(:),nprj(:)
3176 306 : real(dp),allocatable :: kij(:),ncore(:),shpf(:,:),tncore(:),coretau(:)
3177 306 : real(dp),allocatable :: tcoretau(:),tnvale(:),tproj(:,:),vhnzc(:),vlocr(:)
3178 306 : real(dp),allocatable :: work1(:),work2(:),work3(:),work4(:)
3179 306 : type(pawrad_type),allocatable :: radmesh(:)
3180 :
3181 : !************************************************************************
3182 :
3183 : if (.False.) write(std_out,*) ipsp
3184 :
3185 : !==========================================================
3186 : !Destroy everything in pawtab but optional flags
3187 306 : call pawtab_free(pawtab)
3188 : !Destroy everything in pawrad
3189 306 : call pawrad_free(pawrad)
3190 :
3191 : !==========================================================
3192 : !Initialize useful data
3193 :
3194 306 : pawtab%usexcnhat=usexcnhat_in
3195 306 : fourpi=4*acos(-1.d0)
3196 306 : pspversion=pawpsp_header%pawver
3197 306 : save_core_msz=(usewvl==1 .or. icoulomb .ne. 0)
3198 306 : imainmesh=-1;icoremesh=-1;icoretaumesh=-1;iprojmesh=-1
3199 306 : ishpfmesh=-1;ivalemesh=-1;ivlocmesh=-1
3200 306 : my_xc_taupos=xc_denpos;if(present(xc_taupos)) my_xc_taupos=xc_taupos
3201 306 : my_el_temp=merge(el_temp,zero,present(el_temp))
3202 :
3203 : !==========================================================
3204 : !Initialize partial waves quantum numbers
3205 :
3206 306 : pawtab%basis_size=pawpsp_header%basis_size
3207 918 : LIBPAW_ALLOCATE(pawtab%orbitals,(pawtab%basis_size))
3208 1655 : do ib=1,pawtab%basis_size
3209 1655 : pawtab%orbitals(ib)=paw_setuploc%valence_states%state(ib)%ll
3210 : end do
3211 :
3212 : !==========================================================
3213 : !Initialize various dims and indexes
3214 :
3215 306 : pawtab%lmn_size=pawpsp_header%lmn_size
3216 306 : pawtab%lmn2_size=pawtab%lmn_size*(pawtab%lmn_size+1)/2
3217 1655 : pawtab%l_size=2*maxval(pawtab%orbitals)+1
3218 306 : pawtab%ij_size=pawtab%basis_size*(pawtab%basis_size+1)/2
3219 :
3220 : !indlmn calculation (indices for (l,m,n) basis)
3221 306 : if (allocated(pawtab%indlmn)) then
3222 0 : LIBPAW_DEALLOCATE(pawtab%indlmn)
3223 : end if
3224 918 : LIBPAW_ALLOCATE(pawtab%indlmn,(6,pawtab%lmn_size))
3225 21887 : pawtab%indlmn(:,:)=0
3226 2267 : LIBPAW_BOUND1_ALLOCATE(nprj,BOUNDS(0,maxval(pawtab%orbitals)))
3227 975 : ilmn=0;iln=0;nprj=0
3228 1655 : do ib=1,pawtab%basis_size
3229 1349 : il=pawtab%orbitals(ib)
3230 1349 : nprj(il)=nprj(il)+1
3231 1349 : iln=iln+1
3232 4432 : do ilm=1,2*il+1
3233 3083 : pawtab%indlmn(1,ilmn+ilm)=il
3234 3083 : pawtab%indlmn(2,ilmn+ilm)=ilm-(il+1)
3235 3083 : pawtab%indlmn(3,ilmn+ilm)=nprj(il)
3236 3083 : pawtab%indlmn(4,ilmn+ilm)=il*il+ilm
3237 3083 : pawtab%indlmn(5,ilmn+ilm)=iln
3238 4432 : pawtab%indlmn(6,ilmn+ilm)=1
3239 : end do
3240 1655 : ilmn=ilmn+2*il+1
3241 : end do
3242 306 : LIBPAW_DEALLOCATE(nprj)
3243 : !Are ilmn (found here) and pawtab%lmn_size compatibles ?
3244 306 : if (ilmn/=pawtab%lmn_size) then
3245 : write(msg, '(a,a,a,a,a)' )&
3246 0 : & 'Calculated lmn size differs from',ch10,&
3247 0 : & 'lmn_size read from pseudo !',ch10,&
3248 0 : & 'Action: check your pseudopotential file.'
3249 0 : LIBPAW_ERROR(msg)
3250 : end if
3251 :
3252 : !==========================================================
3253 : !Read and initialize radial meshes
3254 :
3255 306 : nmesh=paw_setuploc%ngrid
3256 1353 : LIBPAW_DATATYPE_ALLOCATE(radmesh,(nmesh))
3257 918 : LIBPAW_ALLOCATE(mesh_shift,(nmesh))
3258 741 : do imsh=1,nmesh
3259 435 : radmesh(imsh)%mesh_type=-1
3260 435 : radmesh(imsh)%rstep=zero
3261 435 : radmesh(imsh)%lstep=zero
3262 435 : mesh_shift(imsh)=0
3263 1176 : select case(trim(paw_setuploc%radial_grid(imsh)%eq))
3264 : case("r=a*exp(d*i)")
3265 0 : mesh_shift(imsh)=1
3266 0 : radmesh(imsh)%mesh_type=3
3267 : radmesh(imsh)%mesh_size=paw_setuploc%radial_grid(imsh)%iend &
3268 0 : & -paw_setuploc%radial_grid(imsh)%istart+1+mesh_shift(imsh)
3269 0 : radmesh(imsh)%rstep=paw_setuploc%radial_grid(imsh)%aa
3270 0 : radmesh(imsh)%lstep=paw_setuploc%radial_grid(imsh)%dd
3271 : case("r=a*i/(1-b*i)")
3272 : write(msg, '(3a)' )&
3273 0 : & 'The grid r=a*i/(1-b*i) is not implemented in ABINIT !',ch10,&
3274 0 : & 'Action: check your psp file.'
3275 0 : LIBPAW_ERROR(msg)
3276 : case("r=a*i/(n-i)")
3277 : mesh_shift(imsh)=0
3278 2 : radmesh(imsh)%mesh_type=5
3279 : radmesh(imsh)%mesh_size=paw_setuploc%radial_grid(imsh)%iend &
3280 2 : & -paw_setuploc%radial_grid(imsh)%istart+1+mesh_shift(imsh)
3281 2 : radmesh(imsh)%rstep=paw_setuploc%radial_grid(imsh)%aa
3282 2 : radmesh(imsh)%lstep=dble(paw_setuploc%radial_grid(imsh)%nn)
3283 : case("r=a*(exp(d*i)-1)")
3284 : mesh_shift(imsh)=0
3285 433 : radmesh(imsh)%mesh_type=2
3286 : radmesh(imsh)%mesh_size=paw_setuploc%radial_grid(imsh)%iend &
3287 433 : & -paw_setuploc%radial_grid(imsh)%istart+1+mesh_shift(imsh)
3288 433 : if(paw_setuploc%radial_grid(imsh)%istart==1)radmesh(imsh)%mesh_size=radmesh(imsh)%mesh_size+1
3289 433 : radmesh(imsh)%rstep=paw_setuploc%radial_grid(imsh)%aa
3290 433 : radmesh(imsh)%lstep=paw_setuploc%radial_grid(imsh)%dd
3291 : case("r=d*i")
3292 : mesh_shift(imsh)=0
3293 0 : radmesh(imsh)%mesh_type=1
3294 : radmesh(imsh)%mesh_size=paw_setuploc%radial_grid(imsh)%iend &
3295 0 : & -paw_setuploc%radial_grid(imsh)%istart+1+mesh_shift(imsh)
3296 0 : if(paw_setuploc%radial_grid(imsh)%istart==1)radmesh(imsh)%mesh_size=radmesh(imsh)%mesh_size+1
3297 0 : radmesh(imsh)%rstep=paw_setuploc%radial_grid(imsh)%dd
3298 : case("r=(i/n+a)^5/a-a^4")
3299 : write(msg, '(3a)' )&
3300 0 : & 'The grid r=(i/n+a)^5/a-a^4 is not implemented in ABINIT !',ch10,&
3301 0 : & 'Action: check your psp file.'
3302 870 : LIBPAW_ERROR(msg)
3303 : end select
3304 : end do
3305 :
3306 : !Initialize radial meshes
3307 741 : do imsh=1,nmesh
3308 741 : call pawrad_init(radmesh(imsh))
3309 : end do
3310 :
3311 306 : pawtab%rpaw=pawpsp_header%rpaw
3312 :
3313 : !==========================================================
3314 : !Here reading shapefunction parameters
3315 :
3316 306 : pawtab%shape_type=pawpsp_header%shape_type
3317 306 : pawtab%shape_lambda=-1;pawtab%shape_sigma=1.d99
3318 306 : pawtab%rshp=pawpsp_header%rshp
3319 306 : pawtab%shape_lambda=paw_setuploc%shape_function%lamb
3320 306 : if(trim(paw_setuploc%shape_function%gtype)=="gauss")pawtab%shape_lambda=2
3321 306 : pawtab%shape_sigma=paw_setuploc%shape_function%rc
3322 : !If shapefunction type is gaussian, check exponent
3323 306 : if (pawtab%shape_type==1) then
3324 2 : if (pawtab%shape_lambda<2) then
3325 : write(msg, '(3a)' )&
3326 0 : & 'For a gaussian shape function, exponent lambda must be >1 !',ch10,&
3327 0 : & 'Action: check your psp file.'
3328 0 : LIBPAW_ERROR(msg)
3329 : end if
3330 : end if
3331 :
3332 : !If shapefunction type is Bessel, deduce here its parameters from rc
3333 306 : if (pawtab%shape_type==3) then
3334 165 : LIBPAW_ALLOCATE(pawtab%shape_alpha,(2,pawtab%l_size))
3335 110 : LIBPAW_ALLOCATE(pawtab%shape_q,(2,pawtab%l_size))
3336 55 : rc=pawtab%rshp;if (rc<1.d-8) rc=pawtab%rpaw
3337 252 : do il=1,pawtab%l_size
3338 252 : call atompaw_shapebes(pawtab%shape_alpha(1:2,il),pawtab%shape_q(1:2,il),il-1,rc)
3339 : end do
3340 : end if
3341 :
3342 : !==========================================================
3343 : !Mirror pseudopotential parameters to the output and log files
3344 :
3345 306 : write(msg,'(a,i2)')' Pseudopotential format is: paw',pspversion
3346 306 : call wrtout(ab_out,msg,'COLL')
3347 306 : call wrtout(std_out, msg,'COLL')
3348 : write(msg,'(2(a,i3),a,64i4)') &
3349 306 : & ' basis_size (lnmax)=',pawtab%basis_size,' (lmn_size=',&
3350 612 : & pawtab%lmn_size,'), orbitals=',pawtab%orbitals(1:pawtab%basis_size)
3351 306 : call wrtout(ab_out,msg,'COLL')
3352 306 : call wrtout(std_out, msg,'COLL')
3353 306 : write(msg,'(a,f11.8)')' Spheres core radius: rc_sph=',pawtab%rpaw
3354 306 : call wrtout(ab_out,msg,'COLL')
3355 306 : call wrtout(std_out, msg,'COLL')
3356 306 : write(msg,'(a,i1,a)')' ',nmesh,' radial meshes are used:'
3357 306 : call wrtout(ab_out,msg,'COLL')
3358 306 : call wrtout(std_out, msg,'COLL')
3359 :
3360 741 : do imsh=1,nmesh
3361 435 : if (radmesh(imsh)%mesh_type==1) &
3362 : & write(msg,'(a,i1,a,i4,a,g12.5)') &
3363 0 : & ' - mesh ',imsh,': r(i)=step*(i-1), size=',radmesh(imsh)%mesh_size,&
3364 0 : & ' , step=',radmesh(imsh)%rstep
3365 435 : if (radmesh(imsh)%mesh_type==2) &
3366 : & write(msg,'(a,i1,a,i4,2(a,g12.5))') &
3367 433 : & ' - mesh ',imsh,': r(i)=AA*[exp(BB*(i-1))-1], size=',radmesh(imsh)%mesh_size,&
3368 866 : & ' , AA=',radmesh(imsh)%rstep,' BB=',radmesh(imsh)%lstep
3369 435 : if (radmesh(imsh)%mesh_type==3) &
3370 : & write(msg,'(a,i1,a,i4,2(a,g12.5))') &
3371 0 : & ' - mesh ',imsh,': r(i)=AA*exp(BB*(i-2)), size=',radmesh(imsh)%mesh_size,&
3372 0 : & ' , AA=',radmesh(imsh)%rstep,' BB=',radmesh(imsh)%lstep
3373 435 : if (radmesh(imsh)%mesh_type==4) &
3374 : & write(msg,'(a,i1,a,i4,a,g12.5)') &
3375 0 : & ' - mesh ',imsh,': r(i)=-AA*ln(1-(i-1)/n), n=size=',radmesh(imsh)%mesh_size,&
3376 0 : & ' , AA=',radmesh(imsh)%rstep
3377 435 : if (radmesh(imsh)%mesh_type==5) &
3378 : & write(msg,'(a,i1,a,i4,2(a,g12.5))') &
3379 2 : & ' - mesh ',imsh,': r(i)=-AA*i/(NN-i)), n=size=',radmesh(imsh)%mesh_size,&
3380 4 : & ' , AA=',radmesh(imsh)%rstep,' NN=',radmesh(imsh)%lstep
3381 435 : call wrtout(ab_out,msg,'COLL')
3382 741 : call wrtout(std_out, msg,'COLL')
3383 : end do
3384 306 : if (pawtab%shape_type==-1) then
3385 : write(msg,'(a)')&
3386 1 : ' Shapefunction is NUMERIC type: directly read from atomic data file'
3387 1 : call wrtout(ab_out,msg,'COLL')
3388 1 : call wrtout(std_out, msg,'COLL')
3389 : end if
3390 306 : if (pawtab%shape_type==1) then
3391 : write(msg,'(2a,a,f6.3,a,i3)')&
3392 2 : & ' Shapefunction is EXP type: shapef(r)=exp(-(r/sigma)**lambda)',ch10,&
3393 4 : & ' with sigma=',pawtab%shape_sigma,' and lambda=',pawtab%shape_lambda
3394 2 : call wrtout(ab_out,msg,'COLL')
3395 2 : call wrtout(std_out, msg,'COLL')
3396 : end if
3397 306 : if (pawtab%shape_type==2) then
3398 : write(msg,'(a)')&
3399 248 : ' Shapefunction is SIN type: shapef(r)=[sin(pi*r/rshp)/(pi*r/rshp)]**2'
3400 248 : call wrtout(ab_out,msg,'COLL')
3401 248 : call wrtout(std_out, msg,'COLL')
3402 : end if
3403 306 : if (pawtab%shape_type==3) then
3404 : write(msg,'(a)')&
3405 55 : & ' Shapefunction is BESSEL type: shapef(r,l)=aa(1,l)*jl(q(1,l)*r)+aa(2,l)*jl(q(2,l)*r)'
3406 55 : call wrtout(ab_out,msg,'COLL')
3407 55 : call wrtout(std_out, msg,'COLL')
3408 : end if
3409 306 : if (pawtab%rshp<1.d-8) then
3410 0 : write(msg,'(a)') ' Radius for shape functions = sphere core radius'
3411 : else
3412 306 : write(msg,'(a,f11.8)') ' Radius for shape functions = ',pawtab%rshp
3413 : end if
3414 306 : call wrtout(ab_out,msg,'COLL')
3415 306 : call wrtout(std_out, msg,'COLL')
3416 :
3417 : !==========================================================
3418 : !Perfom tests
3419 :
3420 : !Are lmax and orbitals compatibles ?
3421 1655 : if (lmax/=maxval(pawtab%orbitals)) then
3422 : write(msg, '(a,a,a)' )&
3423 0 : & 'lmax /= MAX(orbitals) !',ch10,&
3424 0 : & 'Action: check your pseudopotential file.'
3425 0 : LIBPAW_ERROR(msg)
3426 : end if
3427 :
3428 : !Only mesh_type=1,2, 3 or 5 allowed
3429 741 : do imsh=1,nmesh
3430 741 : if (radmesh(imsh)%mesh_type>5) then
3431 : write(msg, '(a,a,a)' )&
3432 0 : & 'Only mesh types 1,2,3 or 5 allowed !',ch10,&
3433 0 : & 'Action : check your pseudopotential or input file.'
3434 0 : LIBPAW_ERROR(msg)
3435 : end if
3436 : end do
3437 :
3438 : !==========================================================
3439 : !Read tabulated atomic data
3440 :
3441 : !---------------------------------
3442 : !Read wave-functions (phi)
3443 :
3444 1655 : do ib=1,pawtab%basis_size
3445 1349 : if (ib==1) then
3446 306 : do imsh=1,nmesh
3447 306 : if(trim(paw_setuploc%ae_partial_wave(1)%grid)==trim(paw_setuploc%radial_grid(imsh)%id)) then
3448 306 : mmax=radmesh(imsh)%mesh_size
3449 : call pawrad_init(pawrad,mesh_size=mmax,mesh_type=radmesh(imsh)%mesh_type, &
3450 306 : & rstep=radmesh(imsh)%rstep,lstep=radmesh(imsh)%lstep,r_for_intg=pawtab%rpaw)
3451 306 : pawtab%partialwave_mesh_size=pawrad%mesh_size
3452 306 : pawtab%mesh_size=pawrad_ifromr(pawrad,pawtab%rpaw)+5
3453 306 : pawtab%mesh_size=min(pawtab%mesh_size,pawrad%mesh_size)
3454 306 : if (pawtab%mesh_size>pawrad%mesh_size-2) pawtab%mesh_size=pawrad%mesh_size
3455 306 : imainmesh=imsh
3456 306 : exit
3457 : end if
3458 : end do
3459 1224 : LIBPAW_ALLOCATE(pawtab%phi,(pawtab%partialwave_mesh_size,pawtab%basis_size))
3460 1043 : else if (trim(paw_setuploc%ae_partial_wave(ib)%grid)/=trim(paw_setuploc%radial_grid(imainmesh)%id)) then
3461 : write(msg, '(a,a,a)' )&
3462 0 : & 'All Phi and tPhi must be given on the same radial mesh !',ch10,&
3463 0 : & 'Action: check your pseudopotential file.'
3464 0 : LIBPAW_ERROR(msg)
3465 : end if
3466 1349 : shft=mesh_shift(imainmesh)
3467 : pawtab%phi(1+shft:pawtab%partialwave_mesh_size,ib)= &
3468 : & paw_setuploc%ae_partial_wave(ib)%data(1:pawtab%partialwave_mesh_size-shft) &
3469 2250725 : & *pawrad%rad(1+shft:pawtab%partialwave_mesh_size)
3470 1655 : if (shft==1) pawtab%phi(1,ib)=zero
3471 : end do
3472 306 : write(msg,'(a,i4)') ' mmax= ',mmax
3473 306 : call wrtout(ab_out,msg,'COLL')
3474 306 : call wrtout(std_out,msg,'COLL')
3475 :
3476 : !---------------------------------
3477 : !Read pseudo wave-functions (tphi)
3478 :
3479 1224 : LIBPAW_ALLOCATE(pawtab%tphi,(pawtab%partialwave_mesh_size,pawtab%basis_size))
3480 1655 : do ib=1,pawtab%basis_size
3481 :
3482 1349 : if(trim(paw_setuploc%pseudo_partial_wave(ib)%grid)/=trim(paw_setuploc%radial_grid(imainmesh)%id)) then
3483 : write(msg, '(a,a,a)' )&
3484 0 : & 'All Phi and tPhi must be given on the same radial mesh !',ch10,&
3485 0 : & 'Action: check your pseudopotential file.'
3486 0 : LIBPAW_ERROR(msg)
3487 : end if
3488 1349 : shft=mesh_shift(imainmesh)
3489 : pawtab%tphi(1+shft:pawtab%partialwave_mesh_size,ib)=&
3490 : & paw_setuploc%pseudo_partial_wave(ib)%data(1:pawtab%partialwave_mesh_size-shft) &
3491 2250725 : & *pawrad%rad(1+shft:pawtab%partialwave_mesh_size)
3492 1655 : if (shft==1) pawtab%tphi(1,ib)=zero
3493 : end do
3494 : write(msg,'(a,i1)') &
3495 306 : & ' Radial grid used for partial waves is grid ',imainmesh
3496 306 : call wrtout(ab_out,msg,'COLL')
3497 306 : call wrtout(std_out, msg,'COLL')
3498 :
3499 : !---------------------------------
3500 : !Read projectors (tproj)
3501 :
3502 306 : if (allocated(paw_setuploc%projector_fit)) then
3503 0 : call wvlpaw_allocate(pawtab%wvl)
3504 0 : LIBPAW_ALLOCATE(pawtab%wvl%pngau,(pawtab%basis_size))
3505 0 : do ib=1,pawtab%basis_size
3506 0 : pawtab%wvl%pngau(ib) = paw_setuploc%projector_fit(ib)%ngauss
3507 : end do
3508 0 : pawtab%wvl%ptotgau = sum(pawtab%wvl%pngau) * 2
3509 0 : LIBPAW_ALLOCATE(pawtab%wvl%parg,(2,pawtab%wvl%ptotgau))
3510 0 : LIBPAW_ALLOCATE(pawtab%wvl%pfac,(2,pawtab%wvl%ptotgau))
3511 0 : pngau = 1
3512 0 : do ib=1,pawtab%basis_size
3513 : ! Complex gaussian
3514 : pawtab%wvl%parg(:,pngau:pngau + pawtab%wvl%pngau(ib) - 1) = &
3515 0 : & paw_setuploc%projector_fit(ib)%expos(:,1:pawtab%wvl%pngau(ib))
3516 : pawtab%wvl%pfac(:,pngau:pngau + pawtab%wvl%pngau(ib) - 1) = &
3517 0 : & paw_setuploc%projector_fit(ib)%factors(:,1:pawtab%wvl%pngau(ib))
3518 0 : pngau = pngau + pawtab%wvl%pngau(ib)
3519 : ! Conjugate gaussian
3520 : pawtab%wvl%parg(1,pngau:pngau + pawtab%wvl%pngau(ib) - 1) = &
3521 0 : & paw_setuploc%projector_fit(ib)%expos(1,1:pawtab%wvl%pngau(ib))
3522 : pawtab%wvl%parg(2,pngau:pngau + pawtab%wvl%pngau(ib) - 1) = &
3523 0 : & -paw_setuploc%projector_fit(ib)%expos(2,1:pawtab%wvl%pngau(ib))
3524 : pawtab%wvl%pfac(1,pngau:pngau + pawtab%wvl%pngau(ib) - 1) = &
3525 0 : & paw_setuploc%projector_fit(ib)%factors(1,1:pawtab%wvl%pngau(ib))
3526 : pawtab%wvl%pfac(2,pngau:pngau + pawtab%wvl%pngau(ib) - 1) = &
3527 0 : & -paw_setuploc%projector_fit(ib)%factors(2,1:pawtab%wvl%pngau(ib))
3528 0 : pngau = pngau + pawtab%wvl%pngau(ib)
3529 0 : pawtab%wvl%pngau(ib) = pawtab%wvl%pngau(ib) * 2
3530 : end do
3531 0 : pawtab%has_wvl=2
3532 : else
3533 : !Nullify wavelet objects for safety:
3534 306 : pawtab%has_wvl=0
3535 306 : call wvlpaw_free(pawtab%wvl)
3536 : end if
3537 1655 : do ib=1,pawtab%basis_size
3538 1349 : if (ib==1) then
3539 337 : do imsh=1,nmesh
3540 337 : if(trim(paw_setuploc%projector_function(1)%grid)==trim(paw_setuploc%radial_grid(imsh)%id)) then
3541 306 : iprojmesh=imsh
3542 306 : exit
3543 : end if
3544 : end do
3545 306 : call pawrad_copy(radmesh(iprojmesh),tproj_mesh)
3546 1224 : LIBPAW_ALLOCATE(tproj,(tproj_mesh%mesh_size,pawtab%basis_size))
3547 1043 : else if (trim(paw_setuploc%projector_function(ib)%grid)/=trim(paw_setuploc%radial_grid(iprojmesh)%id)) then
3548 : write(msg, '(a,a,a)' )&
3549 0 : & 'All tprojectors must be given on the same radial mesh !',ch10,&
3550 0 : & 'Action: check your pseudopotential file.'
3551 0 : LIBPAW_ERROR(msg)
3552 : end if
3553 1349 : shft=mesh_shift(iprojmesh)
3554 : tproj(1+shft:tproj_mesh%mesh_size,ib)=paw_setuploc%projector_function(ib)%data(1:tproj_mesh%mesh_size-shft)&
3555 2250101 : & *tproj_mesh%rad(1+shft:tproj_mesh%mesh_size)
3556 1655 : if (shft==1) tproj(1,ib)=zero
3557 : end do
3558 : write(msg,'(a,i1)') &
3559 306 : & ' Radial grid used for projectors is grid ',iprojmesh
3560 306 : call wrtout(ab_out,msg,'COLL')
3561 306 : call wrtout(std_out, msg,'COLL')
3562 :
3563 : !---------------------------------
3564 : !Read core density (coredens)
3565 :
3566 364 : do imsh=1,nmesh
3567 364 : if(trim(paw_setuploc%ae_core_density%grid)==trim(paw_setuploc%radial_grid(imsh)%id)) then
3568 306 : icoremesh=imsh
3569 306 : exit
3570 : end if
3571 : end do
3572 306 : call pawrad_copy(radmesh(icoremesh),core_mesh)
3573 : if ((radmesh(icoremesh)%mesh_type/=pawrad%mesh_type).or.&
3574 306 : & (radmesh(icoremesh)%rstep /=pawrad%rstep) .or.&
3575 : & (radmesh(icoremesh)%lstep /=pawrad%lstep)) then
3576 : write(msg, '(a,a,a,a,a)' )&
3577 0 : & 'Ncore must be given on a radial mesh with the same',ch10,&
3578 0 : & 'type and step(s) than the main radial mesh (mesh for Phi) !',ch10,&
3579 0 : & 'Action: check your pseudopotential file.'
3580 0 : LIBPAW_ERROR(msg)
3581 : end if
3582 918 : LIBPAW_ALLOCATE(ncore,(core_mesh%mesh_size))
3583 306 : shft=mesh_shift(icoremesh)
3584 514059 : ncore(1+shft:core_mesh%mesh_size)=paw_setuploc%ae_core_density%data(1:core_mesh%mesh_size-shft)/sqrt(fourpi)
3585 306 : if (shft==1) call pawrad_deducer0(ncore,core_mesh%mesh_size,core_mesh)
3586 :
3587 : !Construct and save VH[z_NC] if requested
3588 306 : if (pawtab%has_vhnzc==1) then
3589 918 : LIBPAW_ALLOCATE(pawtab%VHnZC,(pawtab%mesh_size))
3590 612 : LIBPAW_ALLOCATE(vhnzc,(core_mesh%mesh_size))
3591 306 : call atompaw_vhnzc(ncore,core_mesh,vhnzc,znucl)
3592 357028 : pawtab%VHnZC(1:pawtab%mesh_size)=vhnzc(1:pawtab%mesh_size)
3593 306 : pawtab%has_vhnzc=2
3594 306 : LIBPAW_DEALLOCATE(vhnzc)
3595 : end if
3596 :
3597 306 : pawtab%core_mesh_size=pawtab%mesh_size
3598 306 : if(save_core_msz) pawtab%core_mesh_size=core_mesh%mesh_size
3599 918 : LIBPAW_ALLOCATE(pawtab%coredens,(pawtab%core_mesh_size))
3600 306 : pawtab%rcore=core_mesh%rad(pawtab%core_mesh_size)
3601 357028 : pawtab%coredens(1:pawtab%core_mesh_size)=ncore(1:pawtab%core_mesh_size)
3602 :
3603 : !---------------------------------
3604 : !Read pseudo core density (tcoredens)
3605 :
3606 364 : do imsh=1,nmesh
3607 364 : if(trim(paw_setuploc%pseudo_core_density%grid)==trim(paw_setuploc%radial_grid(imsh)%id)) then
3608 306 : iread1=imsh
3609 306 : exit
3610 : end if
3611 : end do
3612 306 : if (iread1/=icoremesh) then
3613 : write(msg, '(a,a,a,a,a,a,a,a)' )&
3614 0 : & 'Pseudized core density (tNcore) must be given',ch10,&
3615 0 : & 'on the same radial mesh as core density (Ncore) !',ch10,&
3616 0 : & 'Action: check your pseudopotential file.'
3617 0 : LIBPAW_ERROR(msg)
3618 : end if
3619 612 : LIBPAW_ALLOCATE(tncore,(core_mesh%mesh_size))
3620 306 : shft=mesh_shift(icoremesh)
3621 514059 : tncore(1+shft:core_mesh%mesh_size)=paw_setuploc%pseudo_core_density%data(1:core_mesh%mesh_size-shft)/sqrt(fourpi)
3622 306 : if (shft==1) call pawrad_deducer0(tncore,core_mesh%mesh_size,core_mesh)
3623 306 : if(save_core_msz) then
3624 0 : LIBPAW_ALLOCATE(pawtab%tcoredens,(pawtab%core_mesh_size,6))
3625 : else
3626 918 : LIBPAW_ALLOCATE(pawtab%tcoredens,(pawtab%core_mesh_size,1))
3627 : end if
3628 514365 : if (maxval(abs(tncore(:)))<tol6) then
3629 53 : pawtab%usetcore=0
3630 62639 : pawtab%tcoredens(1:pawtab%core_mesh_size,:)=zero
3631 : else
3632 253 : pawtab%usetcore=1
3633 294442 : pawtab%tcoredens(1:pawtab%core_mesh_size,1)=tncore(1:pawtab%core_mesh_size)
3634 : end if
3635 : write(msg,'(a,i1)') &
3636 306 : & ' Radial grid used for (t)core density is grid ',icoremesh
3637 306 : call wrtout(ab_out,msg,'COLL')
3638 306 : call wrtout(std_out, msg,'COLL')
3639 :
3640 : !---------------------------------
3641 : !Read core kinetic density (coretau)
3642 :
3643 306 : if (paw_setuploc%ae_core_kinetic_energy_density%tread.and.pawtab%has_coretau>=1) then
3644 14 : do imsh=1,nmesh
3645 14 : if(trim(paw_setuploc%ae_core_kinetic_energy_density%grid)==trim(paw_setuploc%radial_grid(imsh)%id)) then
3646 14 : icoretaumesh=imsh
3647 14 : exit
3648 : end if
3649 : end do
3650 14 : call pawrad_copy(radmesh(icoretaumesh),coretau_mesh)
3651 14 : if (icoretaumesh/=icoremesh) then
3652 : write(msg, '(5a)' )&
3653 0 : & 'Core kinetic density (TAUcore) must be given',ch10,&
3654 0 : & 'on the same radial mesh as core density (Ncore) !',ch10,&
3655 0 : & 'Action: check your pseudopotential file.'
3656 0 : LIBPAW_ERROR(msg)
3657 : end if
3658 42 : LIBPAW_ALLOCATE(coretau,(coretau_mesh%mesh_size))
3659 14 : shft=mesh_shift(icoretaumesh)
3660 : coretau(1+shft:coretau_mesh%mesh_size)= &
3661 28024 : & paw_setuploc%ae_core_kinetic_energy_density%data(1:coretau_mesh%mesh_size-shft)/sqrt(fourpi)
3662 14 : if (shft==1) call pawrad_deducer0(coretau,coretau_mesh%mesh_size,coretau_mesh)
3663 14 : pawtab%coretau_mesh_size=pawtab%mesh_size
3664 14 : if(save_core_msz) pawtab%coretau_mesh_size=coretau_mesh%mesh_size
3665 42 : LIBPAW_ALLOCATE(pawtab%coretau,(pawtab%coretau_mesh_size))
3666 14 : pawtab%rcoretau=coretau_mesh%rad(pawtab%coretau_mesh_size)
3667 19730 : pawtab%coretau(1:pawtab%coretau_mesh_size)=coretau(1:pawtab%coretau_mesh_size)
3668 292 : else if (pawtab%has_coretau>=1) then
3669 : write(msg, '(5a)' )&
3670 0 : & 'metaGGA exchange-correlation is requested but the core kinetic energy density',ch10,&
3671 0 : & 'is not present in the pseudopotential file!',ch10,&
3672 0 : & 'Action: check your pseudopotential file.'
3673 0 : LIBPAW_ERROR(msg)
3674 : end if
3675 :
3676 : !---------------------------------
3677 : !Read pseudo core kinetic energy density (tcoretau)
3678 :
3679 306 : if (paw_setuploc%pseudo_core_kinetic_energy_density%tread.and.pawtab%has_coretau>=1) then
3680 14 : do imsh=1,nmesh
3681 14 : if(trim(paw_setuploc%pseudo_core_kinetic_energy_density%grid)==trim(paw_setuploc%radial_grid(imsh)%id)) then
3682 14 : iread1=imsh
3683 14 : exit
3684 : end if
3685 : end do
3686 14 : if (iread1/=icoretaumesh) then
3687 : write(msg, '(5a)' )&
3688 0 : & 'Pseudized core kinetic energy density (tTAUcore) must be given',ch10,&
3689 0 : & 'on the same radial mesh as core kinetic density (TAUcore) !',ch10,&
3690 0 : & 'Action: check your pseudopotential file.'
3691 0 : LIBPAW_ERROR(msg)
3692 : end if
3693 42 : LIBPAW_ALLOCATE(tcoretau,(coretau_mesh%mesh_size))
3694 14 : shft=mesh_shift(icoretaumesh)
3695 : tcoretau(1+shft:coretau_mesh%mesh_size)= &
3696 28024 : & paw_setuploc%pseudo_core_kinetic_energy_density%data(1:coretau_mesh%mesh_size-shft)/sqrt(fourpi)
3697 14 : if (shft==1) call pawrad_deducer0(tcoretau,coretau_mesh%mesh_size,coretau_mesh)
3698 42 : LIBPAW_ALLOCATE(pawtab%tcoretau,(pawtab%coretau_mesh_size))
3699 19730 : pawtab%tcoretau(1:pawtab%coretau_mesh_size)=tcoretau(1:pawtab%coretau_mesh_size)
3700 14 : pawtab%has_coretau=2
3701 : write(msg,'(a,i1)') &
3702 14 : & ' Radial grid used for (t)coretau kinetic density is grid ',icoretaumesh
3703 14 : call wrtout(ab_out,msg,'COLL')
3704 14 : call wrtout(std_out, msg,'COLL')
3705 292 : else if (pawtab%has_coretau>=1) then
3706 : write(msg, '(5a)' )&
3707 0 : & 'metaGGA exchange-correlation is requested but the pseudo core kinetic energy density',ch10,&
3708 0 : & 'is not present in the pseudopotential file!',ch10,&
3709 0 : & 'Action: check your pseudopotential file.'
3710 0 : LIBPAW_ERROR(msg)
3711 : end if
3712 :
3713 : !---------------------------------
3714 : !Read local pseudopotential=Vh(tn_zc) or Vbare
3715 :
3716 306 : if ((paw_setuploc%blochl_local_ionic_potential%tread).and.&
3717 : & (pawtab%usexcnhat==-1.or.pawtab%usexcnhat==0.or.(pawtab%usexcnhat==1.and.&
3718 : & ((.not.paw_setuploc%zero_potential%tread).or.(.not.paw_setuploc%kresse_joubert_local_ionic_potential%tread))))) then
3719 284 : usexcnhat=0;vlocopt=2
3720 328 : do imsh=1,nmesh
3721 328 : if(trim(paw_setuploc%blochl_local_ionic_potential%grid)==trim(paw_setuploc%radial_grid(imsh)%id)) then
3722 284 : iread1=imsh
3723 284 : exit
3724 : end if
3725 : end do
3726 284 : ivlocmesh=iread1
3727 284 : call pawrad_copy(radmesh(ivlocmesh),vloc_mesh)
3728 852 : LIBPAW_ALLOCATE(vlocr,(vloc_mesh%mesh_size))
3729 284 : shft=mesh_shift(ivlocmesh)
3730 501032 : vlocr(1+shft:vloc_mesh%mesh_size)=paw_setuploc%blochl_local_ionic_potential%data(1:vloc_mesh%mesh_size-shft)/sqrt(fourpi)
3731 284 : if (shft==1) call pawrad_deducer0(vlocr,vloc_mesh%mesh_size,vloc_mesh)
3732 22 : else if((paw_setuploc%kresse_joubert_local_ionic_potential%tread).and.&
3733 : & (pawtab%usexcnhat==-1.or.pawtab%usexcnhat==1.or.(pawtab%usexcnhat==0.and.&
3734 : & (.not.paw_setuploc%zero_potential%tread)))) then
3735 12 : usexcnhat=1;vlocopt=1
3736 39 : do imsh=1,nmesh
3737 39 : if(trim(paw_setuploc%kresse_joubert_local_ionic_potential%grid)==trim(paw_setuploc%radial_grid(imsh)%id)) then
3738 12 : iread1=imsh
3739 12 : exit
3740 : end if
3741 : end do
3742 12 : ivlocmesh=iread1
3743 12 : call pawrad_copy(radmesh(ivlocmesh),vloc_mesh)
3744 36 : LIBPAW_ALLOCATE(vlocr,(vloc_mesh%mesh_size))
3745 12 : shft=mesh_shift(ivlocmesh)
3746 : vlocr(1+shft:vloc_mesh%mesh_size)= &
3747 9818 : & paw_setuploc%kresse_joubert_local_ionic_potential%data(1:vloc_mesh%mesh_size-shft)/sqrt(fourpi)
3748 12 : if (shft==1) call pawrad_deducer0(vlocr,vloc_mesh%mesh_size,vloc_mesh)
3749 10 : else if(paw_setuploc%zero_potential%tread) then
3750 10 : usexcnhat=0;vlocopt=0
3751 34 : do imsh=1,nmesh
3752 34 : if(trim(paw_setuploc%zero_potential%grid)==trim(paw_setuploc%radial_grid(imsh)%id)) then
3753 10 : iread1=imsh
3754 10 : exit
3755 : end if
3756 : end do
3757 10 : ivlocmesh=iread1
3758 : ! vloc_mesh%mesh_type=radmesh(ivlocmesh)%mesh_type
3759 : ! vloc_mesh%rstep=radmesh(ivlocmesh)%rstep
3760 : ! vloc_mesh%lstep=radmesh(ivlocmesh)%lstep
3761 : ! vloc_mesh%mesh_size=radmesh(ivlocmesh)%mesh_size
3762 : ! vloc_mesh%mesh_size=pawrad_ifromr(radmesh(ivlocmesh),rmax_vloc)
3763 10 : call pawrad_copy(radmesh(ivlocmesh),vloc_mesh)
3764 30 : LIBPAW_ALLOCATE(vlocr,(vloc_mesh%mesh_size))
3765 5462 : vlocr=zero
3766 10 : shft=mesh_shift(ivlocmesh)
3767 5462 : vlocr(1+shft:vloc_mesh%mesh_size)=paw_setuploc%zero_potential%data(1:vloc_mesh%mesh_size-shft)/sqrt(fourpi)
3768 10 : if (shft==1) call pawrad_deducer0(vlocr,vloc_mesh%mesh_size,vloc_mesh)
3769 : else
3770 : write(msg, '(a,a,a,a,a)' )&
3771 0 : & 'At least one local potential must be given',ch10,&
3772 0 : & 'Action: check your pseudopotential file.'
3773 0 : LIBPAW_ERROR(msg)
3774 : end if
3775 :
3776 : write(msg,'(a,i1)') &
3777 306 : & ' Radial grid used for Vloc is grid ',ivlocmesh
3778 306 : call wrtout(ab_out,msg,'COLL')
3779 306 : call wrtout(std_out, msg,'COLL')
3780 :
3781 : !-------------------------------------------------
3782 : !Read LDA-1/2 potential
3783 :
3784 306 : if (paw_setuploc%LDA_minus_half_potential%tread) then
3785 2 : do imsh=1,nmesh
3786 2 : if(trim(paw_setuploc%LDA_minus_half_potential%grid)==trim(paw_setuploc%radial_grid(imsh)%id)) then
3787 2 : iread1=imsh
3788 2 : exit
3789 : end if
3790 : end do
3791 2 : if(iread1/=ivlocmesh) then
3792 : write(msg, '(a)' )&
3793 0 : & 'The LDA-1/2 potential must be given on the same grid as the local potential.'
3794 0 : LIBPAW_ERROR(msg)
3795 : end if
3796 2 : has_v_minushalf=1
3797 6 : LIBPAW_ALLOCATE(pawtab%vminushalf,(vloc_mesh%mesh_size))
3798 2 : shft=mesh_shift(ivlocmesh)
3799 2 : pawtab%vminus_mesh_size=vloc_mesh%mesh_size
3800 : pawtab%vminushalf(1+shft:vloc_mesh%mesh_size)= &
3801 4004 : & paw_setuploc%LDA_minus_half_potential%data(1:vloc_mesh%mesh_size-shft)/sqrt(fourpi)
3802 2 : if (shft==1) call pawrad_deducer0(pawtab%vminushalf,vloc_mesh%mesh_size,vloc_mesh)
3803 : write(msg,'(a,i1)') &
3804 2 : & ' Radial grid used for LDA-1/2 potential is grid ',ivlocmesh
3805 2 : call wrtout(ab_out,msg,'COLL')
3806 2 : call wrtout(std_out, msg,'COLL')
3807 : else
3808 : has_v_minushalf=0
3809 : end if
3810 304 : if(has_v_minushalf==0.and.pawtab%has_vminushalf==1) then
3811 : write(msg, '(a)' )&
3812 0 : & 'The LDA-1/2 potential must be given in the XML PAW datafile.'
3813 0 : LIBPAW_ERROR(msg)
3814 : end if
3815 :
3816 : !---------------------------------
3817 : !Eventually read "numeric" shapefunctions (if shape_type=-1)
3818 :
3819 306 : if (pawtab%shape_type==-1) then
3820 4 : LIBPAW_ALLOCATE(pawtab%shapefunc,(pawtab%mesh_size,pawtab%l_size))
3821 1 : do imsh=1,nmesh
3822 1 : if(trim(paw_setuploc%shape_function%grid)==trim(paw_setuploc%radial_grid(imsh)%id)) then
3823 1 : iread1=imsh
3824 1 : exit
3825 : end if
3826 : end do
3827 1 : call pawrad_copy(radmesh(iread1),shpf_mesh)
3828 1 : ishpfmesh=iread1
3829 4 : LIBPAW_ALLOCATE(shpf,(shpf_mesh%mesh_size,pawtab%l_size))
3830 1 : shft=mesh_shift(ishpfmesh)
3831 1 : shpf(1,1)=one
3832 594 : do ir=2,shpf_mesh%mesh_size
3833 594 : shpf(ir,1)=paw_setuploc%shape_function%data(ir-shft,1)
3834 : end do
3835 1 : sz10=size(paw_setuploc%shape_function%data,2)
3836 1 : if(sz10>=2) then
3837 5 : do il=2,pawtab%l_size
3838 4 : shpf(1,il)=zero
3839 2377 : do ir=2,shpf_mesh%mesh_size
3840 2376 : shpf(ir,il)=paw_setuploc%shape_function%data(ir-shft,il)
3841 : end do
3842 : end do
3843 : else
3844 0 : do il=2,pawtab%l_size
3845 0 : shpf(1,il)=zero
3846 0 : do ir=2,shpf_mesh%mesh_size
3847 0 : shpf(ir,il)=paw_setuploc%shape_function%data(ir-shft,1)*shpf_mesh%rad(ir)**(il-1)
3848 : end do
3849 : end do
3850 : end if
3851 : write(msg,'(a,i1)') &
3852 1 : & ' Radial grid used for shape functions is grid ',iread1
3853 1 : call wrtout(ab_out,msg,'COLL')
3854 1 : call wrtout(std_out, msg,'COLL')
3855 :
3856 : ! Has to spline shape functions if mesh is not the "main" mesh
3857 1 : if (ishpfmesh/=imainmesh) then
3858 0 : msz=shpf_mesh%mesh_size
3859 0 : LIBPAW_ALLOCATE(work1,(msz))
3860 0 : LIBPAW_ALLOCATE(work2,(msz))
3861 0 : LIBPAW_ALLOCATE(work3,(msz))
3862 0 : LIBPAW_ALLOCATE(work4,(pawrad%mesh_size))
3863 0 : work3(1:msz)=shpf_mesh%rad(1:msz)
3864 0 : work4(1:pawrad%mesh_size)=pawrad%rad(1:pawrad%mesh_size)
3865 0 : do il=1,pawtab%l_size
3866 0 : call bound_deriv(shpf(1:msz,il),shpf_mesh,msz,yp1,ypn)
3867 0 : call paw_spline(work3,shpf(:,il),msz,yp1,ypn,work1)
3868 0 : call paw_splint(msz,work3,shpf(:,il),work1,pawrad%mesh_size,work4,pawtab%shapefunc(:,il))
3869 : end do
3870 0 : LIBPAW_DEALLOCATE(work1)
3871 0 : LIBPAW_DEALLOCATE(work2)
3872 0 : LIBPAW_DEALLOCATE(work3)
3873 0 : LIBPAW_DEALLOCATE(work4)
3874 : else
3875 2976 : pawtab%shapefunc(:,:)=shpf(:,:)
3876 : end if
3877 1 : LIBPAW_DEALLOCATE(shpf)
3878 : end if
3879 :
3880 : !---------------------------------
3881 : !Read pseudo valence density
3882 :
3883 306 : if (paw_setuploc%pseudo_valence_density%tread) then
3884 432 : do imsh=1,nmesh
3885 432 : if(trim(paw_setuploc%pseudo_valence_density%grid)==trim(paw_setuploc%radial_grid(imsh)%id)) then
3886 305 : iread1=imsh
3887 305 : exit
3888 : end if
3889 : end do
3890 305 : ivalemesh=iread1
3891 305 : call pawrad_copy(radmesh(iread1),vale_mesh)
3892 915 : LIBPAW_ALLOCATE(tnvale,(vale_mesh%mesh_size))
3893 305 : shft=mesh_shift(ivalemesh)
3894 517598 : tnvale(1+shft:vale_mesh%mesh_size)=paw_setuploc%pseudo_valence_density%data(1:vale_mesh%mesh_size-shft)/sqrt(fourpi)
3895 305 : if (shft==1) call pawrad_deducer0(tnvale,vale_mesh%mesh_size,vale_mesh)
3896 305 : pawtab%has_tvale=1
3897 : write(msg,'(a,i1)') &
3898 305 : & ' Radial grid used for pseudo valence density is grid ',ivalemesh
3899 305 : call wrtout(ab_out,msg,'COLL')
3900 305 : call wrtout(std_out, msg,'COLL')
3901 : else
3902 1 : pawtab%has_tvale=0
3903 1 : LIBPAW_ALLOCATE(tnvale,(0))
3904 : end if
3905 :
3906 : !---------------------------------
3907 : !Read initial guess of rhoij (rhoij0)
3908 :
3909 918 : LIBPAW_ALLOCATE(pawtab%rhoij0,(pawtab%lmn2_size))
3910 22076 : pawtab%rhoij0=zero
3911 306 : ilmn0=0
3912 1655 : do ib=1,pawtab%basis_size
3913 1349 : il=2*pawtab%orbitals(ib)+1
3914 1349 : occ=paw_setuploc%valence_states%state(ib)%ff
3915 : if (occ<zero)occ=zero
3916 4432 : do ilmn=ilmn0+1,ilmn0+il
3917 4432 : pawtab%rhoij0(ilmn*(ilmn+1)/2)=occ/dble(il)
3918 : end do
3919 1655 : ilmn0=ilmn0+il
3920 : end do
3921 :
3922 : !---------------------------------
3923 : !Read Kij terms (kij0) and deduce eventually Dij0
3924 :
3925 612 : LIBPAW_ALLOCATE(kij,(pawtab%lmn2_size))
3926 22076 : kij=zero
3927 306 : nval=paw_setuploc%valence_states%nval
3928 3389 : do jlmn=1,pawtab%lmn_size
3929 3083 : j0lmn=jlmn*(jlmn-1)/2
3930 3083 : jlm=pawtab%indlmn(4,jlmn);jln=pawtab%indlmn(5,jlmn)
3931 25159 : do ilmn=1,jlmn
3932 21770 : klmn=j0lmn+ilmn
3933 21770 : ilm=pawtab%indlmn(4,ilmn);iln=pawtab%indlmn(5,ilmn)
3934 24853 : if (ilm==jlm) kij(klmn)=paw_setuploc%kinetic_energy_differences%data(jln+(iln-1)*nval)
3935 : end do
3936 : end do
3937 306 : if (vlocopt>0) then
3938 592 : LIBPAW_ALLOCATE(pawtab%dij0,(pawtab%lmn2_size))
3939 296 : if (allocated(pawtab%vminushalf).and.pawtab%has_vminushalf==1) then
3940 2002 : vlocr(1:vloc_mesh%mesh_size)=vlocr(1:vloc_mesh%mesh_size)+pawtab%vminushalf(1:vloc_mesh%mesh_size)
3941 : end if
3942 : call atompaw_dij0(pawtab%indlmn,kij,pawtab%lmn_size,ncore,0,pawtab,pawrad,core_mesh,&
3943 296 : & vloc_mesh,vlocr,znucl)
3944 : end if
3945 :
3946 : !Keep eventualy Kij in memory
3947 306 : if (pawtab%has_kij==1.or.vlocopt==0) then
3948 138 : LIBPAW_ALLOCATE(pawtab%kij,(pawtab%lmn2_size))
3949 4311 : pawtab%kij(:)=kij(:)
3950 46 : if (vlocopt> 0) pawtab%has_kij=2
3951 : ! This -1 means that pawtab%kij will be freed later
3952 46 : if (vlocopt==0) pawtab%has_kij=-1
3953 : end if
3954 :
3955 306 : LIBPAW_DEALLOCATE(kij)
3956 :
3957 : !---------------------------------
3958 : !Read exact-exchange Fock terms for core-valence interactions (ex_cvij)
3959 :
3960 306 : if (paw_setuploc%exact_exchange_matrix%tread.eqv..true.) then
3961 271 : pawtab%has_fock=2
3962 813 : LIBPAW_ALLOCATE(pawtab%ex_cvij,(pawtab%lmn2_size))
3963 20646 : pawtab%ex_cvij=zero
3964 271 : nval=paw_setuploc%valence_states%nval
3965 3064 : do jlmn=1,pawtab%lmn_size
3966 2793 : j0lmn=jlmn*(jlmn-1)/2
3967 2793 : jlm=pawtab%indlmn(4,jlmn);jln=pawtab%indlmn(5,jlmn)
3968 23439 : do ilmn=1,jlmn
3969 20375 : klmn=j0lmn+ilmn
3970 20375 : ilm=pawtab%indlmn(4,ilmn);iln=pawtab%indlmn(5,ilmn)
3971 23168 : if (ilm==jlm) pawtab%ex_cvij(klmn)=paw_setuploc%exact_exchange_matrix%data(jln+(iln-1)*nval)
3972 : end do
3973 : end do
3974 271 : pawtab%ex_cc=paw_setuploc%ex_cc
3975 : end if
3976 :
3977 : !----------------------------------------
3978 : !Store Lamb shielding
3979 306 : pawtab%lamb_shielding=paw_setuploc%lamb_shielding
3980 :
3981 : !Store kinetic core energy
3982 306 : pawtab%ekincore=paw_setuploc%ekin_core
3983 :
3984 : !==========================================================
3985 : !Compute additional atomic data only depending on present DATASET
3986 :
3987 : call pawpsp_calc(core_mesh,epsatm,ffspl,imainmesh,hyb_mixing,ixc,lnmax,&
3988 : & mmax,mqgrid_ff,mqgrid_vl,ncore,nmesh,pawrad,pawtab,pawxcdev,pspversion,&
3989 : & qgrid_ff,qgrid_vl,radmesh,tncore,tnvale,tproj,tproj_mesh,usexcnhat,vale_mesh,&
3990 : & vloc_mesh,vlocopt,vlocr,vlspl,xcccrc,xclevel,xc_denpos,zion,znucl,&
3991 306 : & tcoretau=tcoretau,coretau_mesh=coretau_mesh,xc_taupos=my_xc_taupos,el_temp=my_el_temp)
3992 :
3993 306 : if(usewvl==1 .or. icoulomb > 0) then
3994 : ! Calculate up to the 5th derivative of tcoredens
3995 0 : call pawpsp_calc_d5(core_mesh,pawtab%core_mesh_size,pawtab%tcoredens)
3996 : ! Other wvl related operations
3997 0 : call pawpsp_wvl_calc(pawtab,tnvale,usewvl,vale_mesh,vloc_mesh,vlocr)
3998 306 : else if (pawtab%has_wvl>0) then
3999 0 : call wvlpaw_rholoc_nullify(pawtab%wvl%rholoc)
4000 : end if
4001 :
4002 : !==========================================================
4003 : !Free temporary allocated space
4004 :
4005 306 : call pawrad_free(radmesh)
4006 741 : LIBPAW_DATATYPE_DEALLOCATE(radmesh)
4007 306 : LIBPAW_DEALLOCATE(mesh_shift)
4008 :
4009 306 : call pawrad_free(tproj_mesh)
4010 306 : call pawrad_free(core_mesh)
4011 306 : call pawrad_free(vloc_mesh)
4012 306 : call pawrad_free(coretau_mesh)
4013 :
4014 306 : if (allocated(vlocr)) then
4015 306 : LIBPAW_DEALLOCATE(vlocr)
4016 : end if
4017 306 : if (allocated(ncore)) then
4018 306 : LIBPAW_DEALLOCATE(ncore)
4019 : end if
4020 306 : if (allocated(tncore)) then
4021 306 : LIBPAW_DEALLOCATE(tncore)
4022 : end if
4023 306 : if (allocated(coretau)) then
4024 14 : LIBPAW_DEALLOCATE(coretau)
4025 : end if
4026 306 : if (allocated(tcoretau)) then
4027 14 : LIBPAW_DEALLOCATE(tcoretau)
4028 : end if
4029 306 : if (allocated(tproj)) then
4030 306 : LIBPAW_DEALLOCATE(tproj)
4031 : end if
4032 :
4033 306 : if(pawtab%shape_type==-1) then
4034 1 : call pawrad_free(shpf_mesh)
4035 : end if
4036 306 : if (paw_setuploc%pseudo_valence_density%tread) then
4037 305 : call pawrad_free(vale_mesh)
4038 : end if
4039 306 : if (paw_setuploc%ae_core_kinetic_energy_density%tread.and.pawtab%has_coretau>=1) then
4040 14 : call pawrad_free(coretau_mesh)
4041 : end if
4042 306 : if (allocated(tnvale)) then
4043 306 : LIBPAW_DEALLOCATE(tnvale)
4044 : end if
4045 :
4046 612 : end subroutine pawpsp_17in
4047 : !!***
4048 :
4049 : !-------------------------------------------------------------------------
4050 :
4051 : !!****f* m_pawpsp/pawpsp_7in
4052 : !! NAME
4053 : !! pawpsp_7in
4054 : !!
4055 : !! FUNCTION
4056 : !! Initialize pspcod=7 ("PAW pseudopotentials"):
4057 : !! continue to read the corresponding file and compute the form factors
4058 : !!
4059 : !! INPUTS
4060 : !! icoulomb==0 : usual reciprocal space computation
4061 : !! =1 : free boundary conditions are used
4062 : !! ipsp=id in the array of the currently read pseudo.
4063 : !! ixc=exchange-correlation choice from main routine data file
4064 : !! lloc=angular momentum choice of local pseudopotential
4065 : !! lmax=value of lmax mentioned at the second line of the psp file
4066 : !! pawxcdev=choice of XC development (0=no dev. (use of angular mesh) ; 1 or 2=dev. on moments)
4067 : !! xclevel= XC functional level
4068 : !! xc_denpos= lowest allowed density (usually for the computation of the XC functionals)
4069 : !! [xc_taupos]= lowest allowed kinetic energy density (for mGGA XC functionals)
4070 : !! [el_temp]=electronic temperature (hartree)
4071 : !! zion=nominal valence of atom as specified in psp file
4072 : !!
4073 : !! OUTPUT
4074 : !! epsatm=$ (4\pi)\int_0^\infty [r^2 (V(r)+\frac{Zv}{r}) dr]$(hartree)
4075 : !! ffspl(psps%mqgrid_ff,2,psps%lnmax)=form factor f_l(q) and second derivative
4076 : !! from spline fit for each angular momentum and each projector;
4077 : !! pawrad <type(pawrad_type)>=paw radial mesh and related data
4078 : !! pawtab <type(pawtab_type)>=paw tabulated starting data
4079 : !! vlspl(mqgrid_vl,2)=q^2 Vloc(q) and second derivatives from spline fit
4080 : !! xcccrc=XC core correction cutoff radius (bohr) from psp file
4081 : !!
4082 : !! NOTES
4083 : !! Spin-orbit not yet implemented (to be done)
4084 : !!
4085 : !! SOURCE
4086 :
4087 231 : subroutine pawpsp_7in(epsatm,ffspl,icoulomb,hyb_mixing,ixc,&
4088 : & lmax,lnmax,mmax,mqgrid_ff,mqgrid_vl,&
4089 231 : & pawrad,pawtab,pawxcdev,qgrid_ff,qgrid_vl,&
4090 231 : & usewvl,usexcnhat_in,vlspl,xcccrc,xclevel,xc_denpos,zion,znucl,&
4091 : & xc_taupos,el_temp) ! Optional argument
4092 :
4093 : !Arguments ------------------------------------
4094 : !scalars
4095 : integer, intent(in):: icoulomb,ixc
4096 : integer, intent(in):: lmax,lnmax,mmax
4097 : integer, intent(in):: mqgrid_ff,mqgrid_vl,pawxcdev
4098 : integer, intent(in):: usewvl,usexcnhat_in,xclevel
4099 : real(dp), intent(in):: hyb_mixing,xc_denpos,zion,znucl
4100 : real(dp), intent(in),optional:: xc_taupos,el_temp
4101 : real(dp), intent(out):: epsatm,xcccrc
4102 : type(pawrad_type), intent(inout):: pawrad
4103 : type(pawtab_type), intent(inout) :: pawtab
4104 : !arrays
4105 : real(dp),intent(in):: qgrid_ff(mqgrid_ff),qgrid_vl(mqgrid_vl)
4106 : real(dp),intent(inout) :: ffspl(mqgrid_ff,2,lnmax)
4107 : real(dp),intent(out) :: vlspl(mqgrid_vl,2)
4108 :
4109 : !Local variables ------------------------------
4110 : !scalars
4111 : integer :: imainmesh,nmesh
4112 : integer :: pspversion,usexcnhat,vlocopt
4113 : logical :: save_core_msz
4114 : real(dp) :: my_xc_taupos,my_el_temp
4115 231 : type(pawrad_type) :: core_mesh,tproj_mesh,vale_mesh,vloc_mesh
4116 : !arrays
4117 231 : real(dp),pointer :: ncore(:),tncore(:),tcoretau(:),tnvale(:),tproj(:,:),vlocr(:)
4118 231 : type(pawrad_type),pointer :: radmesh(:)
4119 :
4120 : !************************************************************************
4121 :
4122 : !Destroy everything in pawtab but optional flags
4123 231 : call pawtab_free(pawtab)
4124 : !Destroy everything in pawrad
4125 231 : call pawrad_free(pawrad)
4126 :
4127 231 : save_core_msz=(usewvl==1 .or. icoulomb .ne. 0)
4128 231 : nullify(ncore);nullify(tncore);nullify(tcoretau);nullify(tnvale)
4129 231 : nullify(tproj);nullify(vlocr)
4130 231 : nullify(radmesh)
4131 :
4132 : call pawpsp_read(core_mesh,tmp_unit,imainmesh,lmax,&
4133 : & ncore,nmesh,pawrad,pawtab,pspversion,radmesh,save_core_msz,&
4134 : & tcoretau,tncore,tnvale,tproj,tproj_mesh,usexcnhat_in,usexcnhat,&
4135 231 : & vale_mesh,vlocopt,vlocr,vloc_mesh,znucl)
4136 :
4137 231 : my_xc_taupos=xc_denpos;if(present(xc_taupos)) my_xc_taupos=xc_taupos
4138 231 : my_el_temp=merge(el_temp,zero,present(el_temp))
4139 : call pawpsp_calc(core_mesh,epsatm,ffspl,imainmesh,hyb_mixing,ixc,lnmax,&
4140 : & mmax,mqgrid_ff,mqgrid_vl,ncore,nmesh,pawrad,pawtab,pawxcdev,pspversion,&
4141 : & qgrid_ff,qgrid_vl,radmesh,tncore,tnvale,tproj,tproj_mesh,usexcnhat,vale_mesh,&
4142 : & vloc_mesh,vlocopt,vlocr,vlspl,xcccrc,xclevel,xc_denpos,zion,znucl,&
4143 231 : & tcoretau=tcoretau,coretau_mesh=core_mesh,xc_taupos=my_xc_taupos,el_temp=my_el_temp)
4144 :
4145 231 : if(usewvl==1 .or. icoulomb > 0) then
4146 : ! Calculate up to the 5th derivative of tcoredens
4147 0 : call pawpsp_calc_d5(core_mesh,pawtab%core_mesh_size,pawtab%tcoredens)
4148 : ! Other wvl related operations
4149 0 : call pawpsp_wvl_calc(pawtab,tnvale,usewvl,vale_mesh,vloc_mesh,vlocr)
4150 231 : else if (pawtab%has_wvl>0) then
4151 0 : call wvlpaw_rholoc_nullify(pawtab%wvl%rholoc)
4152 : end if
4153 :
4154 : !==========================================================
4155 : !Free temporary allocated space
4156 231 : call pawrad_free(radmesh)
4157 231 : call pawrad_free(tproj_mesh)
4158 231 : call pawrad_free(core_mesh)
4159 231 : call pawrad_free(vloc_mesh)
4160 231 : LIBPAW_DATATYPE_DEALLOCATE(radmesh)
4161 231 : if (associated(vlocr)) then
4162 231 : LIBPAW_POINTER_DEALLOCATE(vlocr)
4163 : end if
4164 231 : if (associated(ncore)) then
4165 231 : LIBPAW_POINTER_DEALLOCATE(ncore)
4166 : end if
4167 231 : if (associated(tncore)) then
4168 231 : LIBPAW_POINTER_DEALLOCATE(tncore)
4169 : end if
4170 231 : if (associated(tnvale)) then
4171 231 : LIBPAW_POINTER_DEALLOCATE(tnvale)
4172 : end if
4173 231 : if (associated(tcoretau)) then
4174 0 : LIBPAW_POINTER_DEALLOCATE(tcoretau)
4175 : end if
4176 231 : if (associated(tproj)) then
4177 231 : LIBPAW_POINTER_DEALLOCATE(tproj)
4178 : end if
4179 231 : if (pspversion>=4) then
4180 90 : call pawrad_free(vale_mesh)
4181 : end if
4182 :
4183 462 : end subroutine pawpsp_7in
4184 : !!***
4185 :
4186 : !-------------------------------------------------------------------------
4187 :
4188 : !!****f* m_pawpsp/pawpsp_wvl_sin2gauss
4189 : !! NAME
4190 : !! pawpsp_wvl_sin2gauss
4191 : !!
4192 : !! FUNCTION
4193 : !! Converts a f(x)=sum_i^N_i a_i sin(b_i x)+ c_i cos( d_i x) to
4194 : !! f(x)=sum_j e_j exp(f_j x), where e and f are complex numbers.
4195 : !!
4196 : !! INPUTS
4197 : !! basis_size = size of the lmn basis
4198 : !! mparam = number of terms in the summatory (N_i, see the expression above)
4199 : !! nparam = Array containing the parameters (a_i, b_i,c_i,d_i)
4200 : !! wvl = wavelets data type
4201 : !!
4202 : !! OUTPUT
4203 : !!
4204 : !! SIDE EFFECTS
4205 : !! On output wvl%pfac and wvl%parg are filled with complex parameters (e_i, f_i)
4206 : !!
4207 : !! NOTES
4208 : !!
4209 : !! SOURCE
4210 :
4211 0 : subroutine pawpsp_wvl_sin2gauss(basis_size,mparam,nparam,&
4212 0 : & param,wvl)
4213 :
4214 : !Arguments ------------------------------------
4215 : integer,intent(in) :: mparam,basis_size
4216 : integer,intent(in) :: nparam(basis_size)
4217 : real(dp),intent(in) :: param(mparam,basis_size)
4218 : type(wvlpaw_type),intent(inout):: wvl
4219 :
4220 : !Local variables ------------------------------
4221 : integer :: i,ii,ib,ngauss,nterm
4222 : real(dp) :: sep
4223 0 : real(dp) :: a1(mparam),a2(mparam),a3(mparam),a4(mparam),a5(mparam)
4224 0 : real(dp) :: b1r(mparam),b2r(mparam),b1i(mparam),b2i(mparam)
4225 : character(len=500) :: message
4226 : !
4227 : !extra variables, use to debug
4228 : !
4229 : !integer::igau,nr,unitp
4230 : !real(dp)::step,rmax
4231 : !real(dp),allocatable::r(:), y(:)
4232 : !complex::fac,arg
4233 : !complex(dp),allocatable::f(:)
4234 : !************************************************************************
4235 :
4236 : ! Convert from \sum(sin+cos) expressions to sums of complex gaussians
4237 : ! (only works for option=4, see fit_gen)
4238 :
4239 : ! get number of coefficients:
4240 0 : ii=0
4241 0 : do ib=1,basis_size
4242 0 : nterm=nparam(ib)/4 !option=4, there are 4 parameters for each term
4243 0 : ii=ii+nterm*2 !two gaussians for each term
4244 : end do
4245 : !
4246 : ! Allocate objects
4247 : !
4248 0 : ngauss=ii
4249 0 : wvl%ptotgau=ngauss !total number of complex gaussians
4250 0 : LIBPAW_ALLOCATE(wvl%pfac,(2,ngauss))
4251 0 : LIBPAW_ALLOCATE(wvl%parg,(2,ngauss))
4252 0 : LIBPAW_ALLOCATE(wvl%pngau,(basis_size))
4253 0 : wvl%pngau(1:basis_size)=nparam(1:basis_size)/2 !option=4
4254 : !
4255 : ii=0
4256 0 : do ib=1,basis_size
4257 : !
4258 : ! Get parameters in sin+cos expansion:
4259 : ! Option4: \sum a1 exp(-a2 x^2) ( a3 sin(k x^2) + a4 cos(k x^2))
4260 : !
4261 0 : nterm=nparam(ib)/4 !option=4
4262 : !
4263 0 : a1(1:nterm)=param(1:nterm,ib)
4264 0 : a2(1:nterm)=param(nterm+1:nterm*2,ib)
4265 0 : a3(1:nterm)=param(nterm*2+1:nterm*3,ib)
4266 0 : a4(1:nterm)=param(nterm*3+1:nterm*4,ib)
4267 : sep=1.1d0
4268 0 : do i=1,nterm
4269 0 : a5(i)=sep**(i)
4270 : end do
4271 :
4272 : ! First check that "a2" is a positive number (it is multiplied by -1, so
4273 : ! that gaussians decay to zero:
4274 0 : if( any(a2(1:nterm) < tol12) ) then
4275 0 : message = 'Real part of Gaussians should be a negative number (they should go to zero at infty)'
4276 0 : LIBPAW_ERROR(message)
4277 : end if
4278 :
4279 : !
4280 : ! Now translate them to a sum of complex gaussians:
4281 : ! pngau(ib)=nterm*2
4282 : ! Two gaussians by term:
4283 : !
4284 : ! First gaussian
4285 0 : b1r(1:nterm)= a1(1:nterm)*a4(1:nterm)/2.d0 !coefficient, real
4286 0 : b1i(1:nterm)=-a1(1:nterm)*a3(1:nterm)/2.d0 !coefficient, imag
4287 0 : b2r(1:nterm)=-a2(1:nterm) !exponential, real
4288 0 : b2i(1:nterm)= a5(1:nterm) !exponential, imag
4289 : !
4290 0 : wvl%pfac(1,ii+1:ii+nterm)=b1r(1:nterm)
4291 0 : wvl%pfac(2,ii+1:ii+nterm)=b1i(1:nterm)
4292 0 : wvl%parg(1,ii+1:ii+nterm)=b2r(1:nterm)
4293 0 : wvl%parg(2,ii+1:ii+nterm)=b2i(1:nterm)
4294 : ! Second gaussian
4295 0 : wvl%pfac(1,ii+nterm+1:ii+nterm*2)= b1r(1:nterm)
4296 0 : wvl%pfac(2,ii+nterm+1:ii+nterm*2)=-b1i(1:nterm)
4297 0 : wvl%parg(1,ii+nterm+1:ii+nterm*2)= b2r(1:nterm)
4298 0 : wvl%parg(2,ii+nterm+1:ii+nterm*2)=-b2i(1:nterm)
4299 : !
4300 0 : ii=ii+nterm*2
4301 : end do
4302 :
4303 : ! begin debug
4304 : ! write(*,*)'pawpsp_wvl_sin2gauss, comment me'
4305 : ! nr=3000
4306 : ! rmax=10.d0
4307 : ! LIBPAW_ALLOCATE(r,(nr))
4308 : ! LIBPAW_ALLOCATE(f,(nr))
4309 : ! LIBPAW_ALLOCATE(y,(nr))
4310 : ! step=rmax/real(nr-1,dp)
4311 : ! do ir=1,nr
4312 : ! r(ir)=real(ir-1,dp)*step
4313 : ! end do
4314 : ! !
4315 : ! ii=0
4316 : ! do ib=1,basis_size
4317 : ! unitp=500+ib
4318 : ! f(:)=czero
4319 : ! !
4320 : ! do igau=1,wvl%pngau(ib)
4321 : ! ii=ii+1
4322 : ! arg=cmplx(wvl%parg(1,ii),wvl%parg(2,ii))
4323 : ! fac=cmplx(wvl%pfac(1,ii),wvl%pfac(2,ii))
4324 : ! f(:)=f(:)+fac*exp(arg*r(:)**2)
4325 : ! end do
4326 : ! do ir=1,nr
4327 : ! write(unitp,'(3f16.7)')r(ir),real(f(ir))!,y(ir)
4328 : ! end do
4329 : ! end do
4330 : ! LIBPAW_DEALLOCATE(r)
4331 : ! LIBPAW_DEALLOCATE(f)
4332 : ! LIBPAW_DEALLOCATE(y)
4333 : ! end debug
4334 :
4335 0 : end subroutine pawpsp_wvl_sin2gauss
4336 : !!***
4337 :
4338 : !-------------------------------------------------------------------------
4339 :
4340 : !!****f* m_pawpsp/pawpsp_read_header
4341 : !! NAME
4342 : !! pawpsp_read_header
4343 : !!
4344 : !! FUNCTION
4345 : !!
4346 : !! INPUTS
4347 : !!
4348 : !! OUTPUT
4349 : !!
4350 : !!
4351 : !! SIDE EFFECTS
4352 : !!
4353 : !! NOTES
4354 : !!
4355 : !! SOURCE
4356 :
4357 :
4358 0 : subroutine pawpsp_read_header(funit,lloc,lmax,mmax,pspcod,pspxc,r2well,zion,znucl)
4359 :
4360 : !Arguments ------------------------------------
4361 : !scalars
4362 : integer,intent(in):: funit
4363 : integer,intent(out):: lloc,lmax,mmax,pspcod,pspxc
4364 : real(dp),intent(out):: r2well,zion,znucl
4365 : !Local variables-------------------------------
4366 : integer:: pspdat
4367 : character(len=fnlen):: title
4368 : character(len=500) :: msg
4369 :
4370 : ! *************************************************************************
4371 :
4372 : !Read and write some description of file from first line (character data)
4373 0 : read (funit,'(a)') title
4374 0 : write(msg, '(a,a)' ) '- ',trim(title)
4375 0 : call wrtout(ab_out,msg,'COLL')
4376 0 : call wrtout(std_out, msg,'COLL')
4377 :
4378 : !Read and write more data describing psp parameters
4379 0 : read (funit,*) znucl,zion,pspdat
4380 : write(msg, '(a,f9.5,f10.5,2x,i8,t47,a)' ) &
4381 0 : & '-',znucl,zion,pspdat,'znucl, zion, pspdat'
4382 0 : call wrtout(ab_out,msg,'COLL')
4383 0 : call wrtout(std_out, msg,'COLL')
4384 :
4385 0 : read (funit,*) pspcod,pspxc,lmax,lloc,mmax,r2well
4386 0 : if(pspxc<0) then
4387 : write(msg, '(i5,i8,2i5,i10,f10.5,t47,a)' ) &
4388 0 : & pspcod,pspxc,lmax,lloc,mmax,r2well,&
4389 0 : & 'pspcod,pspxc,lmax,lloc,mmax,r2well'
4390 : else
4391 : write(msg, '(4i5,i10,f10.5,t47,a)' ) &
4392 0 : & pspcod,pspxc,lmax,lloc,mmax,r2well,&
4393 0 : & 'pspcod,pspxc,lmax,lloc,mmax,r2well'
4394 : end if
4395 0 : call wrtout(ab_out,msg,'COLL')
4396 0 : call wrtout(std_out, msg,'COLL')
4397 :
4398 0 : end subroutine pawpsp_read_header
4399 : !!***
4400 :
4401 : !-------------------------------------------------------------------------
4402 :
4403 : !!****f* m_pawpsp/pawpsp_read_header_2
4404 : !! NAME
4405 : !! pawpsp_read_header_2
4406 : !!
4407 : !! FUNCTION
4408 : !!
4409 : !! INPUTS
4410 : !!
4411 : !! OUTPUT
4412 : !!
4413 : !!
4414 : !! SIDE EFFECTS
4415 : !!
4416 : !! NOTES
4417 : !! Reads pspversion, basis_size and lmn_size
4418 : !!
4419 : !! SOURCE
4420 :
4421 :
4422 231 : subroutine pawpsp_read_header_2(funit,pspversion,basis_size,lmn_size)
4423 :
4424 : !Arguments ------------------------------------
4425 : !scalars
4426 : integer,intent(in):: funit
4427 : integer,intent(out) :: pspversion,basis_size,lmn_size
4428 :
4429 : !Local variables-------------------------------
4430 : integer :: creatorid
4431 : character(len=80) :: pspline
4432 : character(len=500) :: msg
4433 :
4434 : ! *************************************************************************
4435 :
4436 : !Read psp version in line 4 of the header
4437 231 : pspversion=1
4438 231 : read (funit,'(a80)') pspline;pspline=adjustl(pspline)
4439 231 : if (pspline(1:3)=="paw".or.pspline(1:3)=="PAW") &
4440 231 : & read(unit=pspline(4:80),fmt=*) pspversion
4441 231 : if (pspversion<1.or.pspversion>5) then
4442 : write(msg, '(a,i2,a,a,a)' )&
4443 0 : & 'This version of PAW psp file (',pspversion,') is not compatible with',ch10,&
4444 0 : & 'current version of Abinit.'
4445 0 : LIBPAW_ERROR(msg)
4446 : end if
4447 :
4448 231 : if (pspversion==1) then
4449 0 : read (unit=pspline,fmt=*) basis_size,lmn_size
4450 : else
4451 : ! Here psp file for Abinit 4.3+
4452 231 : read (unit=pspline(5:80),fmt=*) creatorid
4453 231 : read (funit,*) basis_size,lmn_size
4454 : end if
4455 :
4456 231 : end subroutine pawpsp_read_header_2
4457 : !!***
4458 :
4459 : !-------------------------------------------------------------------------
4460 :
4461 : !!****f* m_pawpsp/pawpsp_wvl
4462 : !! NAME
4463 : !! pawpsp_wvl
4464 : !!
4465 : !! FUNCTION
4466 : !! WVL+PAW related operations
4467 : !!
4468 : !! INPUTS
4469 : !!
4470 : !! OUTPUT
4471 : !!
4472 : !! SIDE EFFECTS
4473 : !!
4474 : !! NOTES
4475 : !!
4476 : !! SOURCE
4477 :
4478 :
4479 0 : subroutine pawpsp_wvl(filpsp,pawrad, pawtab,usewvl, wvl_ngauss, comm_mpi)
4480 :
4481 : !Arguments------------------------------------
4482 : !scalars
4483 : integer, optional,intent(in):: comm_mpi
4484 : integer, intent(in):: usewvl, wvl_ngauss(2)
4485 : character(len=fnlen),intent(in)::filpsp
4486 : type(pawrad_type),intent(in) :: pawrad
4487 : type(pawtab_type),intent(inout):: pawtab
4488 : !arrays
4489 :
4490 : !Local variables-------------------------------
4491 : !scalars
4492 : integer:: ii, me, mparam, nterm_bounds(2)
4493 0 : type(pawrad_type)::tproj_mesh
4494 : character(len=500) :: msg
4495 : !arrays
4496 0 : integer,allocatable:: ngauss_param(:)
4497 0 : real(dp),allocatable:: gauss_param(:,:)
4498 :
4499 : ! *************************************************************************
4500 :
4501 0 : me=0; if (present(comm_mpi))me=xmpi_comm_rank(comm_mpi)
4502 :
4503 : !If usewvl flag is on, we must have the pawtab%wvl pointer allocated
4504 0 : if (usewvl==1.and.pawtab%has_wvl==0) then
4505 0 : call wvlpaw_allocate(pawtab%wvl)
4506 0 : pawtab%has_wvl=1
4507 : end if
4508 :
4509 : !Fit projectors to a sum of Gaussians:
4510 0 : if (usewvl ==1 .and. pawtab%wvl%ptotgau==0 ) then
4511 :
4512 0 : if (pawtab%has_tproj==0) then
4513 0 : msg='pawtab%tproj must be allocated'
4514 0 : LIBPAW_BUG(msg)
4515 : end if
4516 :
4517 : ! 1) fit projectors to gaussians
4518 0 : write(msg,'(a,a)')ch10,'Fitting tproj to Gaussians'
4519 0 : call wrtout(std_out,msg,'COLL')
4520 :
4521 : ! See fit_gen (option==4):
4522 0 : do ii=1,2
4523 0 : nterm_bounds(ii)=ceiling(wvl_ngauss(ii)/2.0)
4524 : end do
4525 0 : mparam=nterm_bounds(2)*4
4526 0 : LIBPAW_ALLOCATE(gauss_param,(mparam,pawtab%basis_size))
4527 0 : LIBPAW_ALLOCATE(ngauss_param,(pawtab%basis_size))
4528 : ! compute tproj_mesh
4529 : call pawrad_init(tproj_mesh,mesh_size=size(pawtab%tproj,1),&
4530 0 : & mesh_type=pawrad%mesh_type,rstep=pawrad%rstep, lstep=pawrad%lstep)
4531 :
4532 0 : if(present(comm_mpi)) then
4533 : call gaussfit_projector(pawtab%basis_size,mparam,&
4534 : & ngauss_param,nterm_bounds,pawtab%orbitals,&
4535 : & gauss_param,tproj_mesh,&
4536 0 : & pawtab%rpaw,pawtab%tproj,comm_mpi)
4537 : else
4538 : call gaussfit_projector(pawtab%basis_size,mparam,&
4539 : & ngauss_param,nterm_bounds,pawtab%orbitals,&
4540 : & gauss_param,tproj_mesh,&
4541 0 : & pawtab%rpaw,pawtab%tproj)
4542 : end if
4543 : ! tproj is now as a sum of sin+cos functions,
4544 : ! convert it to a sum of complex gaussians and fill %wvl object:
4545 : call pawpsp_wvl_sin2gauss(pawtab%basis_size,mparam,&
4546 0 : & ngauss_param,gauss_param,pawtab%wvl)
4547 0 : LIBPAW_DEALLOCATE(gauss_param)
4548 0 : LIBPAW_DEALLOCATE(ngauss_param)
4549 :
4550 0 : if(me==0) then
4551 0 : call pawpsp_rw_atompaw(pawtab%basis_size,filpsp,pawtab%wvl)
4552 : end if
4553 :
4554 0 : pawtab%has_wvl=2
4555 :
4556 : end if
4557 :
4558 : !Projectors in real space are no more needed
4559 0 : call pawrad_free(tproj_mesh)
4560 0 : if(allocated(pawtab%tproj)) then
4561 0 : LIBPAW_DEALLOCATE(pawtab%tproj)
4562 0 : pawtab%has_tproj=0
4563 : end if
4564 :
4565 0 : end subroutine pawpsp_wvl
4566 : !!***
4567 :
4568 : !-------------------------------------------------------------------------
4569 :
4570 : !!****f* m_pawpsp/pawpsp_read_header_xml
4571 : !! NAME
4572 : !! pawpsp_read_header_xml
4573 : !!
4574 : !! FUNCTION
4575 : !!
4576 : !! INPUTS
4577 : !!
4578 : !! OUTPUT
4579 : !!
4580 : !! SIDE EFFECTS
4581 : !!
4582 : !! NOTES
4583 : !! This is done instead of: call pawpsxml2ab( psxml, pspheads,1)
4584 : !! since pspheads does not exist in PAW library.
4585 : !! should we include it to avoid the following code replica?
4586 : !! check pspheads commented out in pawpsp_17in, and routine pawpsp_read_xml_2
4587 : !!
4588 : !! SOURCE
4589 :
4590 494 : subroutine pawpsp_read_header_xml(lloc,lmax,pspcod,pspxc,&
4591 : & psxml,r2well,zion,znucl)
4592 :
4593 : !Arguments ------------------------------------
4594 : !scalars
4595 : type(paw_setup_t),intent(in) :: psxml
4596 : integer,intent(out):: lloc,lmax,pspcod,pspxc
4597 : real(dp),intent(out):: r2well,zion,znucl
4598 : !Local variables-------------------------------
4599 : integer :: il
4600 : #if defined LIBPAW_HAVE_LIBXC
4601 : integer :: ii,id
4602 : #endif
4603 : character(len=100) :: xclibxc
4604 : character(len=500) :: msg
4605 : !arrays
4606 :
4607 : ! *************************************************************************
4608 :
4609 494 : lloc = 0
4610 494 : r2well = 0
4611 494 : pspcod=17
4612 494 : znucl=psxml%atom%znucl
4613 494 : zion =psxml%atom%zval
4614 :
4615 : !lmax:
4616 494 : lmax = 0
4617 2697 : do il=1,psxml%valence_states%nval
4618 2697 : if(psxml%valence_states%state(il)%ll>lmax) lmax=psxml%valence_states%state(il)%ll
4619 : end do
4620 : !pspxc
4621 494 : select case(trim(psxml%xc_functional%name))
4622 : case('PZ')
4623 0 : pspxc = 2
4624 : #if defined LIBPAW_HAVE_LIBXC
4625 : pspxc = -(libxc_functionals_getid('XC_LDA_X')*1000 &
4626 0 : & +libxc_functionals_getid('XC_LDA_C_PZ'))
4627 : #endif
4628 : case('W')
4629 0 : pspxc = 4
4630 : #if defined LIBPAW_HAVE_LIBXC
4631 : pspxc = -(libxc_functionals_getid('XC_LDA_X')*1000 &
4632 0 : & +libxc_functionals_getid('XC_LDA_C_WIGNER'))
4633 : #endif
4634 : case('HL')
4635 0 : pspxc = 5
4636 : #if defined LIBPAW_HAVE_LIBXC
4637 : pspxc = -(libxc_functionals_getid('XC_LDA_X')*1000 &
4638 0 : & +libxc_functionals_getid('XC_LDA_C_HL'))
4639 : #endif
4640 : case('GL')
4641 : #if defined LIBPAW_HAVE_LIBXC
4642 : pspxc = -(libxc_functionals_getid('XC_LDA_X')*1000 &
4643 0 : & +libxc_functionals_getid('XC_LDA_C_GL'))
4644 : #else
4645 : write(msg, '(7a)' )&
4646 : & 'The exchange and correlation functional by Gunnarson-Lundqvist', ch10,&
4647 : & 'is not implemented in Abinit.',ch10,&
4648 : & 'Action : choose another XC functional in the pseudopotential',ch10, &
4649 : & ' generation or compile ABINIT with the libXC library.'
4650 : LIBPAW_ERROR(msg)
4651 : #endif
4652 : case('VWN')
4653 : #if defined LIBPAW_HAVE_LIBXC
4654 : pspxc = -(libxc_functionals_getid('XC_LDA_X')*1000 &
4655 0 : & +libxc_functionals_getid('XC_LDA_C_VWN'))
4656 : #else
4657 : write(msg, '(7a)' )&
4658 : & 'The exchange and correlation functional by Vosko,Wilk and Nusair', ch10,&
4659 : & 'is not implemented in Abinit.',ch10,&
4660 : & 'Action : choose another XC functional in the pseudopotential',ch10, &
4661 : & ' generation or compile ABINIT with the libXC library.'
4662 : LIBPAW_ERROR(msg)
4663 : #endif
4664 : case('PW')
4665 132 : pspxc = 7
4666 : #if defined LIBPAW_HAVE_LIBXC
4667 : pspxc = -(libxc_functionals_getid('XC_LDA_X')*1000 &
4668 132 : & +libxc_functionals_getid('XC_LDA_C_PW'))
4669 : #endif
4670 : case('PBE')
4671 362 : pspxc = 11
4672 : #if defined LIBPAW_HAVE_LIBXC
4673 : pspxc = -(libxc_functionals_getid('XC_GGA_X_PBE')*1000 &
4674 362 : & +libxc_functionals_getid('XC_GGA_C_PBE'))
4675 : #endif
4676 : case('revPBE')
4677 0 : pspxc = 14
4678 : #if defined LIBPAW_HAVE_LIBXC
4679 : pspxc = -(libxc_functionals_getid('XC_GGA_X_PBE_R')*1000 &
4680 0 : & +libxc_functionals_getid('XC_GGA_C_PBE'))
4681 : #endif
4682 : case('RPBE')
4683 0 : pspxc = 15
4684 : #if defined LIBPAW_HAVE_LIBXC
4685 : pspxc = -(libxc_functionals_getid('XC_GGA_X_RPBE')*1000 &
4686 0 : & +libxc_functionals_getid('XC_GGA_C_PBE'))
4687 : #endif
4688 : case('PW91')
4689 : #if defined LIBPAW_HAVE_LIBXC
4690 : pspxc = -(libxc_functionals_getid('XC_GGA_X_PW91')*1000 &
4691 0 : & +libxc_functionals_getid('XC_GGA_C_PW91'))
4692 : #else
4693 : write(msg, '(7a)' )&
4694 : & 'The exchange and correlation functional by Perdew and Wang 91', ch10,&
4695 : & 'is not implemented in Abinit.',ch10,&
4696 : & 'Action : choose another XC functional in the pseudopotential',ch10, &
4697 : & ' generation or compile ABINIT with the libXC library.'
4698 : LIBPAW_ERROR(msg)
4699 : #endif
4700 : case('BLYP')
4701 : #if defined LIBPAW_HAVE_LIBXC
4702 : pspxc = -(libxc_functionals_getid('XC_GGA_X_B88')*1000 &
4703 0 : & +libxc_functionals_getid('XC_GGA_C_LYP'))
4704 : #else
4705 : write(msg, '(7a)' )&
4706 : & 'The exchange and correlation functional BLYP', ch10,&
4707 : & 'is not implemented in Abinit.',ch10,&
4708 : & 'Action : choose another XC functional in the pseudopotential',ch10, &
4709 : & ' generation or compile ABINIT with the libXC library.'
4710 : LIBPAW_ERROR(msg)
4711 : #endif
4712 : case DEFAULT
4713 0 : xclibxc=trim(psxml%xc_functional%name)
4714 : if (xclibxc(1:3)=='XC_' .or.xclibxc(1:3)=='xc_' .or. &
4715 : & xclibxc(1:5)=='LDA_X'.or.xclibxc(1:5)=='LDA_C'.or. &
4716 : & xclibxc(1:5)=='lda_x'.or.xclibxc(1:5)=='lda_c'.or. &
4717 : & xclibxc(1:5)=='GGA_X'.or.xclibxc(1:5)=='GGA_C'.or. &
4718 : & xclibxc(1:5)=='gga_x'.or.xclibxc(1:5)=='gga_c'.or. &
4719 : & xclibxc(1:6)=='MGGA_X'.or.xclibxc(1:6)=='MGGA_C'.or. &
4720 494 : & xclibxc(1:6)=='mgga_x'.or.xclibxc(1:6)=='mgga_c') then
4721 : #if defined LIBPAW_HAVE_LIBXC
4722 0 : pspxc=0
4723 0 : ii=index(xclibxc,'+') ; if (ii<=0) ii=0
4724 : if (ii>0) then
4725 0 : id=libxc_functionals_getid(xclibxc(1:ii-1))
4726 0 : if (id<=0) then
4727 0 : write(msg, '(3a)' ) 'The ',xclibxc(1:ii-1), &
4728 0 : & ' functional (read from PAW-XML file) was not found in the libXC library!'
4729 0 : LIBPAW_ERROR(msg)
4730 : end if
4731 0 : pspxc=pspxc-id*1000
4732 : end if
4733 0 : id=libxc_functionals_getid(xclibxc(ii+1:))
4734 0 : if (id<=0) then
4735 0 : write(msg, '(3a)' ) 'The ',xclibxc(ii+1:), &
4736 0 : & ' functional (read from PAW-XML file) was not found in the libXC library!'
4737 0 : LIBPAW_ERROR(msg)
4738 : end if
4739 0 : pspxc=pspxc-id
4740 : #else
4741 : msg='Cannot use LibXC functional because ABINIT is not compiled with LibXC !'
4742 : LIBPAW_ERROR(msg)
4743 : #endif
4744 : ! To be eliminated later (temporary)
4745 0 : else if(trim(psxml%xc_functional%functionaltype)=='LIBXC')then
4746 : #if defined LIBPAW_HAVE_LIBXC
4747 0 : xclibxc=trim(psxml%xc_functional%name)
4748 0 : read(unit=xclibxc,fmt=*) pspxc
4749 0 : pspxc=-pspxc
4750 : #else
4751 : msg='Cannot use LibXC functional because ABINIT is not compiled with LibXC !'
4752 : LIBPAW_ERROR(msg)
4753 : #endif
4754 : else
4755 0 : write(msg, '(3a)') 'Unknown XC functional in psp file: ',trim(xclibxc),' !'
4756 0 : LIBPAW_ERROR(msg)
4757 : end if
4758 : end select
4759 :
4760 494 : end subroutine pawpsp_read_header_xml
4761 : !!***
4762 :
4763 : !-------------------------------------------------------------------------
4764 :
4765 : !!****f* m_pawpsp/pawpsp_read_pawheader
4766 : !! NAME
4767 : !! pawpsp_read_pawheader
4768 : !!
4769 : !! FUNCTION
4770 : !!
4771 : !! INPUTS
4772 : !!
4773 : !! OUTPUT
4774 : !!
4775 : !! SIDE EFFECTS
4776 : !!
4777 : !! NOTES
4778 : !!
4779 : !! SOURCE
4780 :
4781 494 : subroutine pawpsp_read_pawheader(basis_size,lmax,lmn_size,&
4782 : & l_size,mesh_size,pspversion,psxml,rpaw,rshp,shape_type)
4783 :
4784 : !Arguments ------------------------------------
4785 : !scalars
4786 : integer,intent(in):: lmax
4787 : integer,intent(out):: basis_size,mesh_size,lmn_size,l_size
4788 : integer,intent(out):: pspversion,shape_type
4789 : real(dp),intent(out)::rpaw,rshp
4790 : type(paw_setup_t),intent(in) :: psxml
4791 : !Local variables-------------------------------
4792 : integer::il
4793 :
4794 : ! *************************************************************************
4795 :
4796 : !All of this was moved from pawpsxml2ab,
4797 : !basis_size
4798 494 : basis_size=psxml%valence_states%nval
4799 : !mesh_size
4800 1144 : do il=1,psxml%ngrid
4801 650 : if(psxml%radial_grid(il)%id==psxml%idgrid) &
4802 988 : & mesh_size=psxml%radial_grid(il)%iend-psxml%radial_grid(il)%istart+1
4803 : end do
4804 : !lmn_size:
4805 494 : lmn_size=0
4806 2697 : do il=1,psxml%valence_states%nval
4807 2697 : lmn_size=lmn_size+2*psxml%valence_states%state(il)%ll+1
4808 : end do
4809 : !lsize
4810 494 : l_size=2*lmax+1
4811 : !pspversion
4812 494 : pspversion=10
4813 : !rpaw:
4814 494 : rpaw=0.d0
4815 494 : if (psxml%rpaw<0.d0) then
4816 212 : do il=1,psxml%valence_states%nval
4817 212 : if(psxml%valence_states%state(il)%rc>rpaw) rpaw=psxml%valence_states%state(il)%rc
4818 : end do
4819 : else
4820 453 : rpaw=psxml%rpaw
4821 : end if
4822 : !shape_type, rshp:
4823 497 : select case(trim(psxml%shape_function%gtype))
4824 : case('gauss')
4825 3 : shape_type=1
4826 3 : rshp=rpaw
4827 : case('bessel')
4828 98 : shape_type=3
4829 98 : rshp=psxml%shape_function%rc
4830 : case('sinc')
4831 391 : shape_type=2
4832 391 : rshp=psxml%shape_function%rc
4833 : case('exp')
4834 0 : shape_type=1
4835 0 : rshp=rpaw
4836 : case('num')
4837 2 : shape_type=-1
4838 494 : rshp=rpaw
4839 : end select
4840 :
4841 494 : end subroutine pawpsp_read_pawheader
4842 : !!***
4843 :
4844 : !-------------------------------------------------------------------------
4845 :
4846 : !!****f* m_pawpsp/pawpsp_bcast
4847 : !! NAME
4848 : !! pawpsp_bcast
4849 : !!
4850 : !! FUNCTION
4851 : !! Communicate paw data to all processors
4852 : !!
4853 : !! INPUTS
4854 : !! comm_mpi= communicator used to broadcast data
4855 : !! lnmax= Max. number of (l,n) components over all type of psps
4856 : !! mqgrid_ff= dimension of ffspl
4857 : !! mqgrid_vl= dimension of vlspl
4858 : !!
4859 : !! OUTPUT
4860 : !! epsatm=$ (4\pi)\int_0^\infty [r^2 (V(r)+\frac{Zv}{r}) dr]$(hartree)
4861 : !! ffspl(mqgrid_ff,2,lnmax)=Kleinman-Bylander form factor f_l(q) and derivative
4862 : !! pawrad=<type pawrad_type>
4863 : !! pawtab=<type pawtab_type>
4864 : !! vlspl(mqgrid_vl,2)=q^2 Vloc(q) and second derivatives from spline fit
4865 : !! xcccrc=XC core correction cutoff radius (bohr) from psp file
4866 : !!
4867 : !! SOURCE
4868 :
4869 276 : subroutine pawpsp_bcast(comm_mpi,epsatm,ffspl,pawrad,pawtab,vlspl,xcccrc)
4870 :
4871 : !Arguments ------------------------------------
4872 : integer,intent(in) :: comm_mpi
4873 : real(dp),intent(inout) :: epsatm,xcccrc
4874 : real(dp),intent(inout) :: ffspl(:,:,:),vlspl(:,:)
4875 : type(pawrad_type),intent(inout) :: pawrad
4876 : type(pawtab_type),intent(inout) :: pawtab
4877 :
4878 : !Local variables-------------------------------
4879 : integer :: ierr,ii,me,nn_dpr
4880 : integer :: siz_ffspl,siz1_ffspl,siz2_ffspl,siz3_ffspl,siz_vlspl,siz1_vlspl,siz2_vlspl
4881 : integer,allocatable :: list_int(:)
4882 276 : real(dp),allocatable :: list_dpr(:)
4883 :
4884 : !*************************************************************************
4885 :
4886 276 : me=xmpi_comm_rank(comm_mpi)
4887 :
4888 : !Broadcast pawrad
4889 276 : call pawrad_bcast(pawrad,comm_mpi)
4890 :
4891 : !Broadcast pawtab (only data read from file)
4892 276 : call pawtab_bcast(pawtab,comm_mpi,only_from_file=.true.)
4893 :
4894 : !Broadcast the sizes of the arrays
4895 276 : LIBPAW_ALLOCATE(list_int,(5))
4896 276 : if (me==0) then
4897 70 : siz1_vlspl=size(vlspl,1); list_int(1)=siz1_vlspl
4898 70 : siz2_vlspl=size(vlspl,2); list_int(2)=siz2_vlspl
4899 70 : siz1_ffspl=size(ffspl,1); list_int(3)=siz1_ffspl
4900 70 : siz2_ffspl=size(ffspl,2); list_int(4)=siz2_ffspl
4901 70 : siz3_ffspl=size(ffspl,3); list_int(5)=siz3_ffspl
4902 : end if
4903 276 : call xmpi_bcast(list_int,0,comm_mpi,ierr)
4904 276 : if (me/=0) then
4905 206 : siz1_vlspl=list_int(1)
4906 206 : siz2_vlspl=list_int(2)
4907 206 : siz1_ffspl=list_int(3)
4908 206 : siz2_ffspl=list_int(4)
4909 206 : siz3_ffspl=list_int(5)
4910 : end if
4911 276 : siz_vlspl=siz1_vlspl*siz2_vlspl
4912 276 : siz_ffspl=siz1_ffspl*siz2_ffspl*siz3_ffspl
4913 276 : LIBPAW_DEALLOCATE(list_int)
4914 :
4915 : !Broadcast the reals
4916 276 : nn_dpr=2+siz_vlspl+siz_ffspl
4917 828 : LIBPAW_ALLOCATE(list_dpr,(nn_dpr))
4918 276 : if (me==0) then
4919 70 : ii=1
4920 70 : list_dpr(ii)=epsatm ;ii=ii+1
4921 70 : list_dpr(ii)=xcccrc ;ii=ii+1
4922 140 : list_dpr(ii:ii+siz_vlspl-1)=reshape(vlspl,(/siz_vlspl/)) ;ii=ii+siz_vlspl
4923 140 : list_dpr(ii:ii+siz_ffspl-1)=reshape(ffspl,(/siz_ffspl/)) ;ii=ii+siz_ffspl
4924 : end if
4925 276 : call xmpi_bcast(list_dpr,0,comm_mpi,ierr)
4926 276 : if (me/=0) then
4927 206 : ii=1
4928 206 : epsatm=list_dpr(ii) ;ii=ii+1
4929 206 : xcccrc=list_dpr(ii) ;ii=ii+1
4930 618 : vlspl=reshape(list_dpr(ii:ii+siz_vlspl-1),(/siz1_vlspl,siz2_vlspl/))
4931 206 : ii=ii+siz_vlspl
4932 824 : ffspl=reshape(list_dpr(ii:ii+siz_ffspl-1),(/siz1_ffspl,siz2_ffspl,siz3_ffspl/))
4933 206 : ii=ii+siz_ffspl
4934 : end if
4935 276 : LIBPAW_DEALLOCATE(list_dpr)
4936 :
4937 276 : end subroutine pawpsp_bcast
4938 : !!***
4939 :
4940 : !-------------------------------------------------------------------------
4941 :
4942 : !!****f* m_pawpsp/pawpsp_main
4943 : !! NAME
4944 : !! pawpsp_main
4945 : !!
4946 : !! FUNCTION
4947 : !! Reads a PAW dataset (atomic data)
4948 : !!
4949 : !! INPUTS
4950 : !! filpsp=name of the file containing the PAW dataset
4951 : !! usewvl=1 if we use a wavelet basis, 0 other wise (plane waves)
4952 : !! icoulomb=1 if we use a Poisson routine with wavelets, 0 otherwise
4953 : !! ixc=index of the XC correlation functional
4954 : !! xclevel=type of XC functional (1=LDA, 2=GGA, ...)
4955 : !! pawxcdev=order of the developement of the PAW on-site terms
4956 : !! (0: full calculation, 1: order 1, 2:order 2)
4957 : !! usexcnhat=flag controlling the use of compensation charge (nhat) in XC potential
4958 : !! qgrid_ff=size of the mesh for the sin FFT transform of the non-local projectors (form factors)
4959 : !! (plane waves only, 0 otherwise)
4960 : !! qgrid_vl=size of the mesh for the sin FFT transform of the local potential
4961 : !! (plane waves only, 0 otherwise)
4962 : !! ffspl=sin FFT transform of the non-local projectors (form factors) (plane waves only)
4963 : !! vlspl=sin FFT transform of the local potential (plane waves only)
4964 : !! epsatm=$ 4\pi\int[r^2 (V(r)+\frac{Zv}{r}dr]$.
4965 : !! xcccrc=XC core correction cutoff radius (bohr)
4966 : !! zionpsp=valence of atom as specified in input file
4967 : !! znuclpsp=atomic number of atom as specified in input file
4968 : !! ===== Optional arguments for wvl =====
4969 : !! [wvl_ngauss]
4970 : !! ===== Other optional arguments =====
4971 : !! [psxml]=datastructure containing a XMP PAW dataset
4972 : !! [comm_mpi]=MPI communicator
4973 : !! [xc_denpos]=tolerance on density for the calculation of XC potential
4974 : !! (if density<xc_denpos, density=zero)
4975 : !! [xc_taupos]=tolerance on kinetic energy density for the calculation of XC potential (mGGA)
4976 : !! [el_temp]=electronic temperature (hartree)
4977 : !!
4978 : !! OUTPUT
4979 : !! pawrad <type(pawrad_type)>=data containing PAW radial grid information
4980 : !! pawtab <type(pawtab_type)>=data containing the PAW dataset (partial waves...)
4981 : !!
4982 : !! SIDE EFFECTS
4983 : !!
4984 : !! NOTES
4985 : !!
4986 : !!
4987 : !! SOURCE
4988 :
4989 0 : subroutine pawpsp_main( &
4990 : & pawrad,pawtab,&
4991 : & filpsp,usewvl,icoulomb,hyb_mixing,ixc,xclevel,pawxcdev,usexcnhat,&
4992 0 : & qgrid_ff,qgrid_vl,ffspl,vlspl,epsatm,xcccrc,zionpsp,znuclpsp,&
4993 : & wvl_ngauss,psxml,comm_mpi,xc_denpos,xc_taupos,el_temp) ! Optional arguments
4994 :
4995 : !Arguments ------------------------------------
4996 : !scalars
4997 : integer,intent(in) :: icoulomb,ixc
4998 : integer,intent(in) :: pawxcdev,usewvl,usexcnhat,xclevel
4999 : integer,optional,intent(in) :: comm_mpi
5000 : real(dp),intent(in):: hyb_mixing,zionpsp,znuclpsp
5001 : real(dp),optional,intent(in) :: xc_denpos,xc_taupos,el_temp
5002 : real(dp),intent(out) :: epsatm,xcccrc
5003 : character(len=fnlen),intent(in):: filpsp ! name of the psp file
5004 : type(pawrad_type),intent(inout) :: pawrad
5005 : type(pawtab_type),intent(inout) :: pawtab
5006 : type(paw_setup_t),optional,intent(in) :: psxml
5007 : !arrays
5008 : integer,optional,intent(in) :: wvl_ngauss(2)
5009 : real(dp),intent(in) :: qgrid_ff(:),qgrid_vl(:)
5010 : real(dp),intent(inout) :: ffspl(:,:,:)
5011 : real(dp),intent(out) :: vlspl(:,:)
5012 :
5013 : !Local variables-------------------------------
5014 : integer :: has_coretau,has_tproj,has_wvl,ipsp,lmax,lloc,lnmax,mmax,me,mqgrid_ff,mqgrid_vl
5015 : integer :: pspcod,pspxc,usexml
5016 : real(dp),parameter :: xc_denpos_default=tol14
5017 : real(dp) :: my_xc_denpos,my_el_temp,my_xc_taupos,r2well,zion,znucl
5018 : character(len=500) :: msg
5019 : type(pawpsp_header_type) :: pawpsp_header
5020 : !arrays
5021 :
5022 : ! *************************************************************************
5023 :
5024 : !Check consistency of parameters
5025 0 : if (icoulomb/= 0.or.usewvl==1) then
5026 0 : if (.not.present(wvl_ngauss)) then
5027 0 : msg='usewvl==1 or icoulomb/=0: a mandatory argument is missing!'
5028 0 : LIBPAW_BUG(msg)
5029 : end if
5030 : end if
5031 :
5032 0 : mqgrid_ff=size(qgrid_ff)
5033 0 : mqgrid_vl=size(qgrid_vl)
5034 0 : lnmax=size(ffspl,3)
5035 0 : if (size(ffspl,1)/=mqgrid_ff.or.size(ffspl,2)/=2) then
5036 0 : msg='invalid sizes for ffspl!'
5037 0 : LIBPAW_BUG(msg)
5038 : end if
5039 0 : if (size(vlspl,1)/=mqgrid_vl.or.size(vlspl,2)/=2) then
5040 0 : msg='invalid sizes for vlspl!'
5041 0 : LIBPAW_BUG(msg)
5042 : end if
5043 :
5044 0 : my_xc_denpos=xc_denpos_default;if (present(xc_denpos)) my_xc_denpos=xc_denpos
5045 0 : my_xc_taupos=my_xc_denpos;if (present(xc_taupos)) my_xc_taupos=xc_taupos
5046 0 : my_el_temp=merge(el_temp,zero,present(el_temp))
5047 0 : pawtab%usexcnhat=usexcnhat
5048 0 : me=0;if (present(comm_mpi))me=xmpi_comm_rank(comm_mpi)
5049 :
5050 0 : has_wvl=0; if (usewvl==1.or.icoulomb/=0) has_wvl=1
5051 0 : has_tproj=0; if (usewvl==1) has_tproj=1
5052 0 : has_coretau=0 ; if (pawxc_get_usekden(ixc)>=1) has_coretau=1
5053 0 : call pawtab_set_flags(pawtab,has_coretau=has_coretau,has_tvale=1,has_wvl=has_wvl,has_tproj=has_tproj)
5054 :
5055 0 : if(me==0) then
5056 0 : write(msg, '(a,t38,a)' )'- pspatm: opening atomic psp file',trim(filpsp)
5057 0 : call wrtout(ab_out, msg,'COLL')
5058 0 : call wrtout(std_out, msg,'COLL')
5059 :
5060 : ! This checks if file is xml or UPF
5061 : ! It sets usexml as well
5062 0 : call pawpsp_check_xml_upf(filpsp)
5063 :
5064 : ! ----------------------------------------------------------------------------
5065 0 : if (usexml /= 1) then
5066 : ! Open the atomic data file, and read the three first lines
5067 0 : open (unit=tmp_unit,file=filpsp,form='formatted',status='old')
5068 0 : rewind (unit=tmp_unit)
5069 : ! Read first 3 lines of psp file:
5070 : call pawpsp_read_header(tmp_unit,lloc,lmax,mmax,pspcod,&
5071 0 : & pspxc,r2well,zion,znucl)
5072 :
5073 0 : else if (usexml == 1 .and. present(psxml)) then
5074 : write(msg,'(a,a)') &
5075 0 : & '- pawpsp : Reading pseudopotential header in XML form from ', trim(filpsp)
5076 0 : call wrtout(ab_out,msg,'COLL')
5077 0 : call wrtout(std_out, msg,'COLL')
5078 :
5079 : ! Return header information
5080 : call pawpsp_read_header_xml(lloc,lmax,pspcod,&
5081 0 : & pspxc,psxml,r2well,zion,znucl)
5082 : ! Fill in pawpsp_header object:
5083 : call pawpsp_read_pawheader(pawpsp_header%basis_size,&
5084 : & lmax,pawpsp_header%lmn_size,&
5085 : & pawpsp_header%l_size,pawpsp_header%mesh_size,&
5086 : & pawpsp_header%pawver,psxml,&
5087 0 : & pawpsp_header%rpaw,pawpsp_header%rshp,pawpsp_header%shape_type)
5088 : end if
5089 :
5090 : ! Check data for consistency against main routine input
5091 0 : call pawpsp_consistency()
5092 :
5093 : ! Read rest of the PSP file
5094 0 : if (pspcod==7) then
5095 : ! ABINIT proprietary format
5096 : call pawpsp_7in(epsatm,ffspl,icoulomb,hyb_mixing,ixc,&
5097 : & lmax,lnmax,mmax,mqgrid_ff,mqgrid_vl,&
5098 : & pawrad,pawtab,pawxcdev,qgrid_ff,qgrid_vl,&
5099 : & usewvl,usexcnhat,vlspl,xcccrc,xclevel,my_xc_denpos,zion,znucl,&
5100 0 : & xc_taupos=my_xc_taupos,el_temp=my_el_temp)
5101 :
5102 0 : else if (pspcod==17)then
5103 : ! XML format
5104 0 : ipsp=1
5105 : call pawpsp_17in(epsatm,ffspl,icoulomb,ipsp,hyb_mixing,ixc,lmax,&
5106 : & lnmax,mmax,mqgrid_ff,mqgrid_vl,pawpsp_header,pawrad,pawtab,&
5107 : & pawxcdev,qgrid_ff,qgrid_vl,usewvl,usexcnhat,vlspl,xcccrc,&
5108 0 : & xclevel,my_xc_denpos,zion,znucl,xc_taupos=my_xc_taupos,el_temp=my_el_temp)
5109 :
5110 : end if
5111 : end if!me==0
5112 :
5113 0 : close(unit=tmp_unit)
5114 :
5115 0 : write(msg,'(3a)') ' pawpsp: atomic psp has been read ',&
5116 0 : & ' and splines computed',ch10
5117 0 : call wrtout(ab_out,msg,'COLL')
5118 0 : call wrtout(std_out, msg,'COLL')
5119 :
5120 : !Communicate PAW objects
5121 0 : if(present(comm_mpi)) then
5122 0 : if(xmpi_comm_size(comm_mpi)>1) then
5123 0 : call pawpsp_bcast(comm_mpi,epsatm,ffspl,pawrad,pawtab,vlspl,xcccrc)
5124 : end if
5125 : end if
5126 :
5127 : !WVL+PAW:
5128 0 : if(icoulomb/=0.or.usewvl==1) then
5129 0 : if(present(comm_mpi))then
5130 0 : call pawpsp_wvl(filpsp,pawrad,pawtab,usewvl,wvl_ngauss,comm_mpi)
5131 : else
5132 0 : call pawpsp_wvl(filpsp,pawrad,pawtab,usewvl,wvl_ngauss)
5133 : end if
5134 : end if
5135 :
5136 : contains
5137 : !!***
5138 :
5139 : !-------------------------------------------------------------------------
5140 :
5141 : !!****f* pawpsp_main/pawpsp_check_xml_upf
5142 : !! NAME
5143 : !! pawpsp_main_checks
5144 : !!
5145 : !! FUNCTION
5146 : !!
5147 : !! INPUTS
5148 : !!
5149 : !! OUTPUT
5150 : !!
5151 : !! SIDE EFFECTS
5152 : !!
5153 : !! NOTES
5154 : !!
5155 : !! SOURCE
5156 :
5157 :
5158 0 : subroutine pawpsp_check_xml_upf(filpsp)
5159 :
5160 : !Arguments ------------------------------------
5161 : !scalars
5162 : character(len=fnlen),intent(in):: filpsp ! name of the psp file
5163 :
5164 : !Local variables-------------------------------
5165 : integer :: unt
5166 : character(len=70):: testxml
5167 :
5168 : ! *************************************************************************
5169 :
5170 : ! Check if the file pseudopotential file is written in XML
5171 0 : usexml = 0
5172 0 : unt = libpaw_get_free_unit()
5173 0 : open (unit=unt,file=filpsp,form='formatted',status='old',action="read")
5174 0 : rewind (unit=unt)
5175 0 : read(unt,*) testxml
5176 0 : if(testxml(1:5)=='<?xml')then
5177 0 : usexml = 1
5178 0 : read(unt,*) testxml
5179 0 : if(testxml(1:4)/='<paw')then
5180 0 : msg='Reading a NC pseudopotential for a PAW calculation?'
5181 0 : LIBPAW_BUG(msg)
5182 : end if
5183 : else
5184 0 : usexml = 0
5185 : end if
5186 0 : close (unit=unt)
5187 :
5188 : ! Check if pseudopotential file is a Q-espresso UPF file
5189 0 : unt = libpaw_get_free_unit()
5190 0 : open (unit=unt,file=filpsp,form='formatted',status='old',action="read")
5191 0 : rewind (unit=unt)
5192 0 : read(unt,*) testxml ! just a string, no relation to xml.
5193 0 : if(testxml(1:9)=='<PP_INFO>')then
5194 0 : msg='UPF format not allowed with PAW (USPP part not read yet)!'
5195 0 : LIBPAW_ERROR(msg)
5196 : end if
5197 0 : close (unit=unt)
5198 :
5199 0 : end subroutine pawpsp_check_xml_upf
5200 : !!***
5201 :
5202 : !-------------------------------------------------------------------------
5203 :
5204 : !!****f* pawpsp_main/pawpsp_consistency
5205 : !! NAME
5206 : !! pawpsp_consistency
5207 : !!
5208 : !! FUNCTION
5209 : !!
5210 : !! INPUTS
5211 : !!
5212 : !! OUTPUT
5213 : !!
5214 : !! SIDE EFFECTS
5215 : !!
5216 : !! NOTES
5217 : !!
5218 : !! SOURCE
5219 :
5220 :
5221 0 : subroutine pawpsp_consistency()
5222 :
5223 : ! *************************************************************************
5224 :
5225 : !Check pspcod=7 or 17
5226 0 : if(pspcod/=7 .and. pspcod/=17)then
5227 : write(msg, '(a,i2,a,a)' )&
5228 0 : & 'In reading atomic psp file, finds pspcod=',pspcod,ch10,&
5229 0 : & 'This is not an allowed value within PAW.'
5230 0 : LIBPAW_BUG(msg)
5231 : end if
5232 :
5233 : !Does nuclear charge znuclpsp agree with psp input znucl
5234 0 : if (abs(znuclpsp-znucl)>tol8) then
5235 : write(msg, '(a,f10.5,2a,f10.5,5a)' )&
5236 0 : & 'Pseudopotential file znucl=',znucl,ch10,&
5237 0 : & 'does not equal input znuclpsp=',znuclpsp,' better than 1e-08 .',ch10,&
5238 0 : & 'znucl is read from the psp file in pspatm_abinit, while',ch10,&
5239 0 : & 'znuclpsp is read in iofn2.'
5240 0 : LIBPAW_BUG(msg)
5241 : end if
5242 :
5243 : !Does nuclear charge zionpsp agree with psp input zion
5244 0 : if (abs(zionpsp-zion)>tol8) then
5245 : write(msg, '(a,f10.5,2a,f10.5,5a)' )&
5246 0 : & 'Pseudopotential file zion=',zion,ch10,&
5247 0 : & 'does not equal input zionpsp=',zionpsp,' better than 1e-08 .',ch10,&
5248 0 : & 'zion is read from the psp file in pawpsp_main, while',ch10,&
5249 0 : & 'zionpsp is read in iofn2.'
5250 0 : LIBPAW_BUG(msg)
5251 : end if
5252 :
5253 : !Check several choices for ixc against pspxc
5254 : !ixc is from ABINIT code; pspxc is from atomic psp file
5255 0 : if (ixc==0) then
5256 0 : msg='Note that input ixc=0 => no xc is being used.'
5257 0 : LIBPAW_WARNING(msg)
5258 0 : else if(ixc/=pspxc) then
5259 : write(msg, '(a,i8,a,a,a,i8,a,a,a,a,a,a,a,a,a,a)' ) &
5260 0 : & 'Pseudopotential file pspxc=',pspxc,',',ch10,&
5261 0 : & 'not equal to input ixc=',ixc,'.',ch10,&
5262 0 : & 'These parameters must agree to get the same xc ',ch10,&
5263 0 : & 'in ABINIT code as in psp construction.',ch10,&
5264 0 : & 'Action : check psp design or input file.',ch10,&
5265 0 : & 'Assume experienced user. Execution will continue.',ch10
5266 0 : LIBPAW_WARNING(msg)
5267 : end if
5268 :
5269 0 : if (lloc>lmax ) then
5270 : write(msg, '(a,2i12,a,a,a,a)' )&
5271 0 : & 'lloc,lmax=',lloc,lmax,ch10,&
5272 0 : & 'chosen l of local psp exceeds range from input data.',ch10,&
5273 0 : & 'Action : check pseudopotential input file.'
5274 0 : LIBPAW_ERROR(msg)
5275 : end if
5276 :
5277 0 : end subroutine pawpsp_consistency
5278 : !!***
5279 :
5280 : end subroutine pawpsp_main
5281 : !!***
5282 :
5283 : !-------------------------------------------------------------------------
5284 :
5285 0 : end module m_pawpsp
5286 : !!***
|
