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