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 [ # # ]: 0 : if (Atm%dirac) then
1624 [ # # # # : 0 : LIBPAW_ALLOCATE(Atm%indlmn,(9,Atm%lmn_size))
# # # # #
# # # #
# ]
1625 : : else
1626 [ # # # # : 0 : LIBPAW_ALLOCATE(Atm%indlmn,(6,Atm%lmn_size))
# # # # #
# # # #
# ]
1627 : : endif
1628 : : else
1629 : : !4)
1630 : 3 : read(unt,*)pspcod,Atm%ixc,lmax
1631 : 3 : write(msg,'(2i5,2x,2x,a)')Atm%ixc,lmax,'ixc,lmax'
1632 : 3 : Atm%l_max = lmax+1
1633 : : !5)
1634 : 3 : read(unt,*) ! skip pspfmt,creatorID
1635 : : !6)
1636 : 3 : read(unt,*)Atm%ln_size, Atm%lmn_size
1637 : : !7)
1638 [ - + + - : 9 : LIBPAW_ALLOCATE(orbitals,(Atm%ln_size))
+ - + - -
+ - + ]
1639 : 3 : read(unt,*) (orbitals(iln), iln=1,Atm%ln_size)
1640 [ + + ]: 12 : lmax = maxval(orbitals)
1641 [ - + ]: 3 : if (lmax+1/=Atm%l_max) then
1642 : 0 : write(msg,'(a)')" lmax read from file does not agree with orbitals. "
1643 : 0 : LIBPAW_ERROR(msg)
1644 : : end if
1645 : : !8)
1646 : 3 : read(unt,*)nmesh
1647 [ - + + - : 9 : LIBPAW_ALLOCATE(meshsz,(nmesh))
+ - + - -
+ - + ]
1648 [ - + + - : 6 : LIBPAW_ALLOCATE(meshtp,(nmesh))
- + - + ]
1649 [ - + + - : 9 : LIBPAW_ALLOCATE(radstp,(nmesh))
+ - + - -
+ - + ]
1650 [ - + + - : 6 : LIBPAW_ALLOCATE(logstp,(nmesh))
- + - + ]
1651 [ + + ]: 6 : do imsh=1,nmesh
1652 : 3 : ls=zero;read(unt,'(a80)') line
1653 [ + - ]: 3 : read(unit=line,fmt=*,err=20,end=20) ii,mt,ms,rs,ls
1654 : : 20 continue
1655 [ + - ]: 6 : if (ii<=nmesh) then
1656 : 3 : meshtp(ii)=mt;meshsz(ii)=ms
1657 : 3 : radstp(ii)=rs;logstp(ii)=ls
1658 : : end if
1659 : : end do
1660 : : !9)
1661 : 3 : read(unt,*) Atm%rcore
1662 : : !10)
1663 [ - + + - : 9 : LIBPAW_ALLOCATE(Atm%indln,(2,Atm%ln_size))
+ - + - -
+ - + -
+ ]
1664 [ - + + - : 12 : LIBPAW_ALLOCATE(Atm%eig,(Atm%ln_size,Atm%nsppol))
- + + - +
- + - - +
- + - + ]
1665 [ - + + - : 9 : LIBPAW_ALLOCATE(Atm%occ,(Atm%ln_size,Atm%nsppol))
- + + - -
+ - + -
+ ]
1666 [ - + + - : 9 : LIBPAW_ALLOCATE(Atm%occ_res,(Atm%ln_size,Atm%nsppol))
- + + - -
+ - + -
+ ]
1667 [ - + + - : 9 : LIBPAW_ALLOCATE(Atm%occ_respc,(Atm%ln_size,Atm%nsppol))
- + + - -
+ - + -
+ ]
1668 [ - + ]: 3 : if (Atm%dirac) then
1669 [ # # # # : 0 : LIBPAW_ALLOCATE(Atm%kappa,(Atm%ln_size))
# # # # #
# # # #
# ]
1670 : : endif
1671 [ + + ]: 6 : do isppol=1,Atm%nsppol
1672 [ + + ]: 15 : do iln=1,Atm%ln_size
1673 : 9 : read(unt,*) ! skip comment
1674 : 9 : read(unt,*) ii
1675 [ + + ]: 9 : if (iln==1.and.isppol==1) then
1676 : 3 : imainmesh=ii
1677 [ + + ]: 3 : if(present(radmesh_in)) then
1678 : 2 : Atm%mesh_size = radmesh_in%mesh_size
1679 : 2 : Atm%rcore=radmesh_in%rad(radmesh_in%mesh_size)
1680 : 2 : call pawrad_copy(radmesh_in,Atm%radmesh)
1681 [ + - ]: 1 : elseif(rcut>tol16) then
1682 : 1 : call pawrad_init(tmpmesh,meshsz(ii),meshtp(ii),radstp(ii),logstp(ii),-one)
1683 : 1 : msz_cut =min(pawrad_ifromr(tmpmesh,rcut)+6,tmpmesh%mesh_size) ! addsix more points
1684 : 1 : Atm%mesh_size = msz_cut
1685 : 1 : Atm%rcore = tmpmesh%rad(msz_cut)
1686 : 1 : call pawrad_init(Atm%radmesh,Atm%mesh_size,meshtp(ii),radstp(ii),logstp(ii),-one)
1687 : 1 : call pawrad_free(tmpmesh)
1688 : : else
1689 : 0 : Atm%mesh_size= meshsz(ii)
1690 : 0 : call pawrad_init(Atm%radmesh,meshsz(ii),meshtp(ii),radstp(ii),logstp(ii),0d0)
1691 : 0 : Atm%rcore=Atm%radmesh%rad(Atm%mesh_size)
1692 : : endif
1693 [ - + + - : 15 : LIBPAW_ALLOCATE(Atm%phi,(Atm%mesh_size,Atm%ln_size,Atm%nsppol))
- + + - -
+ + - + -
+ - - + -
+ - + ]
1694 [ + - - - ]: 6 : else if ((ii/=imainmesh).and.(.not.present(radmesh_in))) then
1695 : : write(msg,'(3a)')&
1696 : 0 : & ' All Phi core must be given on the same radial mesh !',ch10,&
1697 : 0 : & ' Action: check your pseudopotential file.'
1698 : 0 : ABI_ERROR(msg)
1699 : : end if
1700 : 9 : read(unt,*) Atm%indln(2,iln),Atm%indln(1,iln),kk
1701 : 9 : read(unt,*) Atm%eig(iln,isppol),Atm%occ(iln,isppol)
1702 : 9 : Atm%eig(iln,isppol)=Atm%eig(iln,isppol)*half ! For consistency reasons (in the legacy coreWF format, energies are in Ry)
1703 [ - + ]: 9 : if(Atm%dirac) then
1704 : 0 : Atm%kappa(iln)=kk
1705 : : endif
1706 : : !11)
1707 [ - + + - : 27 : LIBPAW_ALLOCATE(phitmp,(meshsz(ii)))
+ - + - -
+ - + -
+ ]
1708 : 9 : read(unt,*) phitmp
1709 [ + + ]: 9 : if (present(radmesh_in)) then
1710 : : if ((radmesh_in%mesh_type/=meshtp(ii)) &
1711 : : & .or.(radmesh_in%rstep/=radstp(ii)) &
1712 [ + - - + : 6 : & .or.(radmesh_in%lstep/=logstp(ii))) then
- - ]
1713 : 6 : call pawrad_init(tmpmesh,mesh_size=meshsz(ii),mesh_type=meshtp(ii),rstep=radstp(ii),lstep=logstp(ii))
1714 : 6 : ms=radmesh_in%mesh_size
1715 [ - + ]: 6 : if (tmpmesh%rmax<radmesh_in%rmax+tol8) ms=pawrad_ifromr(radmesh_in,tmpmesh%rmax)-1
1716 [ - + + - : 18 : LIBPAW_ALLOCATE(work,(meshsz(ii)))
+ - + - -
+ - + ]
1717 : 6 : call bound_deriv(phitmp,tmpmesh,meshsz(ii),deriv1,deriv2)
1718 : 6 : call paw_spline(tmpmesh%rad,phitmp,meshsz(ii),deriv1,deriv2,work)
1719 : 6 : call paw_splint(meshsz(ii),tmpmesh%rad,phitmp,work,ms,radmesh_in%rad(1:ms),Atm%phi(1:ms,iln,isppol))
1720 [ - + - - ]: 6 : if (ms<radmesh_in%mesh_size) Atm%phi(ms+1:radmesh_in%mesh_size,iln,isppol)=zero
1721 [ - + ]: 6 : LIBPAW_DEALLOCATE(work)
1722 : 12 : call pawrad_free(tmpmesh)
1723 : : else
1724 : 0 : ms=min(meshsz(ii),radmesh_in%mesh_size)
1725 [ # # ]: 0 : Atm%phi(1:ms,iln,isppol)=phitmp(1:ms)
1726 [ # # # # ]: 0 : if (ms<radmesh_in%mesh_size) Atm%phi(ms+1:radmesh_in%mesh_size,iln,isppol)=zero
1727 : : end if
1728 : : else
1729 [ + + ]: 4149 : Atm%phi(:,iln,isppol) = phitmp(1:Atm%mesh_size)
1730 : : endif
1731 [ - + ]: 12 : LIBPAW_DEALLOCATE(phitmp)
1732 : : end do
1733 : : enddo
1734 [ - + ]: 3 : LIBPAW_DEALLOCATE(meshsz)
1735 [ - + ]: 3 : LIBPAW_DEALLOCATE(meshtp)
1736 [ - + ]: 3 : LIBPAW_DEALLOCATE(radstp)
1737 [ - + ]: 3 : LIBPAW_DEALLOCATE(logstp)
1738 : :
1739 : 3 : Atm%l_size =2*Atm%l_max-1
1740 : 3 : Atm%ln2_size = Atm%ln_size *(Atm%ln_size +1)/2
1741 : 3 : Atm%lmn2_size = Atm%lmn_size*(Atm%lmn_size+1)/2
1742 : :
1743 [ - + ]: 3 : if(Atm%dirac) then
1744 : 0 : call make_indlmn(Atm%ln_size, Atm%lmn_size,orbitals,Atm%indlmn,kappa=Atm%kappa)
1745 : : else
1746 : 3 : call make_indlmn(Atm%ln_size, Atm%lmn_size, orbitals, Atm%indlmn)
1747 : : endif
1748 : :
1749 : : ! * Setup of indklmn and klm_diag.
1750 [ - + + - : 9 : LIBPAW_ALLOCATE(Atm%indklmn,(8,Atm%lmn2_size))
+ - + - -
+ - + -
+ ]
1751 [ - + + - : 9 : LIBPAW_ALLOCATE(Atm%klm_diag,(Atm%lmn2_size))
+ - + - -
+ - + -
+ ]
1752 : 3 : call make_indklmn(HUGE(1), Atm%lmn_size, Atm%lmn2_size, Atm%indlmn,Atm%indklmn, Atm%klm_diag)
1753 : :
1754 : : ! * Setup of klmntomn.
1755 [ - + + - : 9 : LIBPAW_ALLOCATE(Atm%klmntomn,(4,Atm%lmn2_size))
+ - + - -
+ - + -
+ ]
1756 [ + + ]: 18 : do jlmn=1,Atm%lmn_size
1757 : 15 : jl= Atm%indlmn(1,jlmn)
1758 : 15 : k0lmn=jlmn*(jlmn-1)/2
1759 [ + + ]: 63 : do ilmn=1,jlmn
1760 : 45 : il= Atm%indlmn(1,ilmn)
1761 : 45 : klmn=k0lmn+ilmn
1762 : 45 : Atm%klmntomn(1,klmn) = Atm%indlmn(2,ilmn)+il+1 ! im
1763 : 45 : Atm%klmntomn(2,klmn) = Atm%indlmn(2,jlmn)+jl+1 ! jm
1764 : 45 : Atm%klmntomn(3,klmn) = Atm%indlmn(3,ilmn) ! in
1765 : 60 : Atm%klmntomn(4,klmn) = Atm%indlmn(3,jlmn) ! jn
1766 : : end do
1767 : : end do
1768 : :
1769 [ - + ]: 3 : LIBPAW_DEALLOCATE(orbitals)
1770 [ - + + - : 15 : LIBPAW_ALLOCATE(Atm%mode,(Atm%ln_size,Atm%nsppol,2))
- + + - +
- + - + -
- + - + -
+ ]
1771 [ + + + + : 33 : Atm%mode = ORB_FROZEN
+ + ]
1772 [ - + + - : 12 : LIBPAW_ALLOCATE(Atm%max_occ,(Atm%ln_size,Atm%nsppol))
- + + - +
- + - - +
- + - + ]
1773 [ + - + - : 18 : Atm%max_occ=Atm%occ
- + - - -
- - - + +
+ + ]
1774 : :
1775 : : ! * Setup of kln2ln.
1776 : : !TODO this has to be tested
1777 : : ! LIBPAW_ALLOCATE(Atm%kln2ln,(6,Atm%ln2_size))
1778 : : ! call make_kln2ln(Atm%lmn_size,Atm%lmn2_size,Atm%ln2_size,Atm%indlmn,Atm%indklmn,Atm%kln2ln)
1779 : :
1780 : : endif
1781 : 3 : close(unt)
1782 : : ! end if
1783 : :
1784 : : !!Core WF file is in old (proprietary) format
1785 : : ! if(oldformat) then
1786 : : ! unt = libpaw_get_free_unit()
1787 : : ! open(unt,file=trim(filename_),form='formatted',action="read")
1788 : : ! do while (dum/='atompaw ')
1789 : : ! read(unt,'(a8)') dum
1790 : : ! end do
1791 : : ! read(unt,'(2i4)') Atm%mesh_size,Atm%ln_size
1792 : : ! Atm%ln2_size = Atm%ln_size *(Atm%ln_size +1)/2
1793 : : ! LIBPAW_ALLOCATE(Atm%indln,(2,Atm%ln_size))
1794 : : ! LIBPAW_ALLOCATE(Atm%eig,(Atm%ln_size,1))
1795 : : ! LIBPAW_ALLOCATE(Atm%phi,(Atm%mesh_size,Atm%ln_size,1))
1796 : : ! LIBPAW_ALLOCATE(Atm%occ,(Atm%ln_size,1))
1797 : : ! LIBPAW_ALLOCATE(rad,(Atm%mesh_size))
1798 : : ! do iln=1,Atm%ln_size
1799 : : ! read(unt,'(a4,i4,a3,i4,a6,f15.7,a8,f15.7)') &
1800 : : !& dum1,Atm%indln(2,iln),dum2,Atm%indln(1,iln),dum3,Atm%occ(iln,1),Atm%eig(iln,1)
1801 : : ! Atm%eig(iln,1)=Atm%eig(iln,1)*half ! For consistency reasons (in the legacy coreWF format, energies are in Ry)
1802 : : ! do ims=1,Atm%mesh_size
1803 : : ! read(unt,*) rad(ims),Atm%phi(ims,iln,1)
1804 : : ! end do
1805 : : ! read(unt,*)
1806 : : ! end do
1807 : : ! call pawrad_init(Atm%radmesh,mesh_size=Atm%mesh_size,mesh_type=1,rstep=rad(2)-rad(1),lstep=zero)
1808 : : ! Atm%rcore=Atm%radmesh%rad(Atm%mesh_size)
1809 : : ! LIBPAW_DEALLOCATE(rad)
1810 : : ! close(unt)
1811 : : ! end if
1812 : :
1813 [ + - - + : 6 : end subroutine pawpsp_read_corewf
- + - + -
+ ]
1814 : : !!***
1815 : :
1816 : : !-------------------------------------------------------------------------
1817 : :
1818 : : !!****f* m_pawpsp/pawpsp_rw_atompaw
1819 : : !! NAME
1820 : : !! pawpsp_rw_atompaw
1821 : : !!
1822 : : !! FUNCTION
1823 : : !!
1824 : : !! INPUTS
1825 : : !!
1826 : : !! OUTPUT
1827 : : !!
1828 : : !! SIDE EFFECTS
1829 : : !!
1830 : : !! NOTES
1831 : : !!
1832 : : !! SOURCE
1833 : :
1834 : 0 : subroutine pawpsp_rw_atompaw(basis_size,filpsp,wvl)
1835 : :
1836 : : !Arguments ------------------------------------
1837 : : integer,intent(in):: basis_size
1838 : : type(wvlpaw_type),intent(in)::wvl
1839 : : character(len=fnlen),intent(in)::filpsp
1840 : : !arrays
1841 : : character(strlen) :: pspline
1842 : : character(len=fnlen)::fname
1843 : :
1844 : : !Local variables-------------------------------
1845 : : integer :: ib,ii,ios,jj,step,iunt,ount
1846 : : !arrays
1847 : :
1848 : : ! *************************************************************************
1849 : 0 : iunt = libpaw_get_free_unit()
1850 : 0 : ount = libpaw_get_free_unit()
1851 : :
1852 : 0 : step=0
1853 : : ! Open psp file for reading
1854 : 0 : open(unit=iunt,file=trim(filpsp),form='formatted',status='old',action="read")
1855 : : ! Open the file for writing
1856 : 0 : write(fname,'(2a)') libpaw_basename(trim(filpsp)),".wvl"
1857 : 0 : open(unit=ount,file=fname,form='formatted',status='unknown',action="write")
1858 : :
1859 : : read_loop: do
1860 [ # # ]: 0 : if(step==0) then
1861 : 0 : read(iunt,'(a)',IOSTAT=ios) pspline
1862 [ # # ]: 0 : if ( ios /= 0 ) exit read_loop
1863 : : if(index(trim(pspline),'CORE_DENSITY')/=0 .and. &
1864 [ # # # # ]: 0 : & index(trim(pspline),'PSEUDO_CORE_DENSITY')==0 .and. &
1865 [ # # ]: 0 : & index(trim(pspline),'TCORE_DENSITY')==0 ) then
1866 : : step=1
1867 : : else
1868 : 0 : write(ount,'(a)') trim(pspline)
1869 : : end if
1870 : : elseif(step==1) then
1871 : : !Write Gaussian projectors:
1872 : 0 : jj=0
1873 [ # # ]: 0 : do ib=1,basis_size
1874 : 0 : write(ount,'(a,i1,a)') "===== GAUSSIAN_TPROJECTOR ",ib,&
1875 : 0 : & " ===== "
1876 : 0 : write(ount,'(i5,1x,i5,1x,a)')wvl%pngau(ib),wvl%ptotgau, ":ngauss, total ngauss"
1877 : 0 : write(ount,'(3(1x,es23.16))')(wvl%parg(:,ii),&
1878 [ # # # # ]: 0 : & ii=jj+1,jj+wvl%pngau(ib))
1879 : 0 : write(ount,'(3(1x,es23.16))')(wvl%pfac(:,ii),&
1880 [ # # # # ]: 0 : & ii=jj+1,jj+wvl%pngau(ib))
1881 : 0 : jj=jj+wvl%pngau(ib)
1882 : : end do
1883 : 0 : write(ount,'(a)') trim(pspline)
1884 : 0 : step=0
1885 : : end if
1886 : : end do read_loop
1887 : :
1888 : 0 : close(iunt)
1889 : 0 : close(ount)
1890 : :
1891 : 0 : end subroutine pawpsp_rw_atompaw
1892 : : !!***
1893 : :
1894 : : !-------------------------------------------------------------------------
1895 : :
1896 : : !!****f* m_pawpsp/pawpsp_calc
1897 : : !! NAME
1898 : : !! pawpsp_calc
1899 : : !!
1900 : : !! FUNCTION
1901 : : !! Performs tests and compute data related to pspcod=7 or 17 ("PAW pseudopotentials")
1902 : : !!
1903 : : !! INPUTS
1904 : : !! core_mesh<type(pawrad_type)>= radial mesh for the core density
1905 : : !! [coretau_mesh<type(pawrad_type)>]=radial mesh for the core kinetic energy density
1906 : : !! imainmesh= serial number of the main mesh
1907 : : !! ixc=exchange-correlation choice from main routine data file
1908 : : !! lnmax=max. number of (l,n) components over all type of psps
1909 : : !! angular momentum of nonlocal pseudopotential
1910 : : !! mqgrid_ff=dimension of q (or G) grid for nl form factors (array ffspl)
1911 : : !! mqgrid_vl=dimension of q (or G) grid for Vloc (array vlspl)
1912 : : !! ncore(core_mesh%mesh_size)= core density
1913 : : !! nmesh= number of radial meshes
1914 : : !! pawrad <type(pawrad_type)>=paw radial mesh and related data
1915 : : !! pawxcdev=choice of XC development (0=no dev. (use of angular mesh) ; 1 or 2=dev. on moments)
1916 : : !! pspversion= version of the atompaw code used to generate paw data.
1917 : : !! qgrid_ff(mqgrid_ff)=values of q on grid from 0 to qmax (bohr^-1) for nl form factors
1918 : : !! qgrid_vl(mqgrid_vl)=values of q on grid from 0 to qmax (bohr^-1) for Vloc
1919 : : !! radmesh(nmesh)<type(pawrad_type)>=paw radial meshes and related data
1920 : : !! tncore(core_mesh%mesh_size)= pseudo core density
1921 : : !! [tcoretau(coretau_mesh%mesh_size)]= pseudo core kinetic energy density
1922 : : !! tproj(tproj_mesh%mesh_size)= non-local projectors in real space
1923 : : !! tproj_mesh<type(pawrad_type)>= radial mesh for the projectors
1924 : : !! usexcnhat=0 if compensation charge density is not included in XC terms
1925 : : !! 1 if compensation charge density is included in XC terms
1926 : : !! vale_mesh<type(pawrad_type)>= radial mesh for the valence density
1927 : : !! xc_denpos= lowest allowed density (usually for the computation of the XC functionals)
1928 : : !! [xc_taupos]= lowest allowed kinetic energy density (for mGGA XC functionals)
1929 : : !! vlocopt= option for the local potential.(0=Vbare, 1=VH(tnzc) with hat in XC, 2=VH(tnzc) w/o hat in XC)
1930 : : !! vlocr(vloc_mesh%mesh_size)= local potential according to vlocopt.
1931 : : !! xclevel= XC functional level
1932 : : !! zion=nominal valence of atom as specified in psp file
1933 : : !! znucl=atomic number of atom as specified in input file to main routine
1934 : : !! [el_temp]=electronic temperature (hartree)
1935 : : !!
1936 : : !! OUTPUT
1937 : : !! epsatm=$ (4\pi)\int_0^\infty [r^2 (V(r)+\frac{Zv}{r}) dr]$(hartree)
1938 : : !! ffspl(mqgrid_ff,2,lnmax)=form factor f_l(q) and second derivative
1939 : : !! from spline fit for each angular momentum and each projector;
1940 : : !! vlspl(mqgrid_vl,2)=q^2 Vloc(q) and second derivatives from spline fit
1941 : : !! xcccrc=XC core correction cutoff radius (bohr) from psp file
1942 : : !!
1943 : : !! SIDE EFFECTS
1944 : : !! pawtab <type(pawtab_type)>=paw tabulated starting data
1945 : : !! tnvale(vale_mesh%mesh_size)= pseudo valence density (+ nhat in output)
1946 : : !! vloc_mesh<type(pawrad_type)>= radial mesh for the local potential
1947 : : !!
1948 : : !! NOTES
1949 : : !!
1950 : : !!
1951 : : !! SOURCE
1952 : :
1953 : 1098 : subroutine pawpsp_calc(core_mesh,epsatm,ffspl,imainmesh,hyb_mixing,ixc,lnmax,&
1954 : 549 : & mmax,mqgrid_ff,mqgrid_vl,ncore,nmesh,pawrad,pawtab,pawxcdev,pspversion,&
1955 : 549 : & qgrid_ff,qgrid_vl,radmesh,tncore,tnvale,tproj,tproj_mesh,usexcnhat,vale_mesh,&
1956 : 549 : & vloc_mesh,vlocopt,vlocr,vlspl,xcccrc,xclevel,xc_denpos,zion,znucl,&
1957 [ + - + + : 549 : & tcoretau,coretau_mesh,xc_taupos,el_temp) !optional
- + ]
1958 : :
1959 : : !Arguments ------------------------------------
1960 : : !scalars
1961 : : integer,intent(in) :: imainmesh,ixc,lnmax,mqgrid_ff,mqgrid_vl
1962 : : integer,intent(in) :: nmesh,pawxcdev,pspversion,usexcnhat,vlocopt
1963 : : integer,intent(in) ::mmax
1964 : : integer,intent(in) :: xclevel
1965 : : real(dp),intent(in) :: hyb_mixing,xc_denpos,zion,znucl
1966 : : real(dp),intent(in),optional :: xc_taupos,el_temp
1967 : : real(dp),intent(out) :: epsatm,xcccrc
1968 : : type(pawrad_type),intent(in) :: core_mesh,tproj_mesh,vale_mesh
1969 : : type(pawrad_type),intent(in),optional :: coretau_mesh
1970 : : type(pawrad_type),intent(inout) ::pawrad,vloc_mesh
1971 : : type(pawtab_type),intent(inout) :: pawtab
1972 : : !arrays
1973 : : real(dp),intent(in) :: ncore(core_mesh%mesh_size),tncore(core_mesh%mesh_size)
1974 : : real(dp),intent(in),optional :: tcoretau(:)
1975 : : real(dp),intent(in) :: qgrid_vl(mqgrid_vl),qgrid_ff(mqgrid_ff)
1976 : : real(dp),intent(inout) :: ffspl(mqgrid_ff,2,lnmax)
1977 : : real(dp),intent(out) :: vlspl(mqgrid_vl,2)
1978 : : real(dp),intent(inout) :: tnvale(vale_mesh%mesh_size*pawtab%has_tvale)
1979 : : real(dp),intent(inout) :: tproj(tproj_mesh%mesh_size,pawtab%basis_size)
1980 : : real(dp),intent(inout) :: vlocr(vloc_mesh%mesh_size)
1981 : : type(pawrad_type),intent(in) :: radmesh(nmesh)
1982 : :
1983 : : !Local variables ------------------------------
1984 : : !scalars
1985 : : integer,parameter :: reduced_mshsz=2501
1986 : : integer :: ib,il,ilm,ilmn,iln,ir,isnotzero,itest
1987 : : integer :: j0lmn,jlm,jlmn,jln,klmn,msz,msz1,msz_tmp,mst_tmp,nspden,usekden
1988 : : logical :: has_dij0,non_magnetic_xc,reduced_ncor,reduced_taucor,reduced_nval,reduced_vloc,testval
1989 : : real(dp),parameter :: reduced_rstep=0.00025_dp,rm_vloc=20.0_dp
1990 : : real(dp) :: d2nvdq0,intg,intvh,lstep_tmp,my_xc_taupos,my_el_temp,qcore,qq,rstep_tmp,yp1,yp2,ypn
1991 : : character(len=500) :: msg
1992 : 549 : type(pawang_type) :: pawang_tmp
1993 : 549 : type(pawrad_type) :: rcore_mesh,rcoretau_mesh,rvale_mesh,rvloc_mesh,tproj_mesh_new
1994 : : !arrays
1995 : : real(dp) :: tmp_qgrid(1),tmp_q2vq(1)
1996 : 549 : real(dp),allocatable :: ncorwk(:),nhat(:),nhatwk(:),nwk(:),r2k(:)
1997 : 549 : real(dp),allocatable :: rtncor(:),rttaucor(:),rtnval(:),rvlocr(:)
1998 : 549 : real(dp),allocatable :: vbare(:),vh(:),vhnzc(:),vxc1(:),vxc2(:)
1999 : 549 : real(dp),allocatable,target :: work1(:),work2(:),work3(:)
2000 : 549 : real(dp),pointer :: tmp1(:),tmp2(:)
2001 : : logical :: tmp_lmselect(1)
2002 : :
2003 : : ! *************************************************************************
2004 : :
2005 : : !==========================================================
2006 : : !Perfom tests on meshes
2007 : :
2008 : : !Are radial meshes for Phi and Vloc compatibles ?
2009 : : ! if (vloc_mesh%rmax<pawrad%rmax) then
2010 : : ! write(msg, '(a,a,a)' )&
2011 : : !& 'Rmax for Vloc < Rmax !',ch10,&
2012 : : !& 'Action : check your pseudopotential (increase Vloc meshSize).'
2013 : : ! LIBPAW_ERROR(msg)
2014 : : ! end if
2015 : :
2016 : : !Check optional arguments
2017 : 549 : my_el_temp=merge(el_temp,zero,present(el_temp))
2018 : 1098 : usekden=merge(0,1,pawtab%has_coretau==0)
2019 [ + - ]: 549 : my_xc_taupos=xc_denpos;if (present(xc_taupos)) my_xc_taupos=xc_taupos
2020 [ + + ]: 549 : if (present(tcoretau)) then
2021 [ + - ]: 14 : if (usekden>=1) then
2022 [ - + ]: 14 : if (.not.(present(coretau_mesh))) then
2023 : 0 : msg='tcoretau present but not coretau_mesh!'
2024 : 0 : LIBPAW_BUG(msg)
2025 : : end if
2026 [ - + ]: 14 : if (size(tcoretau)>coretau_mesh%mesh_size) then
2027 : 0 : msg='wrong size for tcoretau!'
2028 : 0 : LIBPAW_BUG(msg)
2029 : : end if
2030 [ - + ]: 14 : if (coretau_mesh%mesh_size<pawtab%mesh_size) then
2031 : : write(msg, '(a,a,a,a,a)' )&
2032 : 0 : & 'Mesh size for core kinetic energy density must be equal or larger',ch10,&
2033 : 0 : & 'than mesh size for PAW augmentation regions !',ch10,&
2034 : 0 : & 'Action : check your pseudopotential (increase TAUcore meshSize).'
2035 : 0 : LIBPAW_ERROR(msg)
2036 : : end if
2037 : : end if
2038 : : end if
2039 : :
2040 : : !Are mmax and mesh_size for partial waves compatibles ?
2041 [ - + ]: 549 : if (mmax/=pawtab%partialwave_mesh_size) then
2042 : : write(msg, '(a,a,a)' )&
2043 : 0 : & 'mmax /= phi_mesh_size in psp file !',ch10,&
2044 : 0 : & 'Action: check your pseudopotential file.'
2045 : 0 : LIBPAW_ERROR(msg)
2046 : : end if
2047 : :
2048 : : !Are radial meshes for (t)Ncore / tTAU and Phi compatibles ?
2049 [ + + - + ]: 549 : if (usekden>=1.and.core_mesh%mesh_size<pawtab%mesh_size) then
2050 : : write(msg, '(a,a,a,a,a)' )&
2051 : 0 : & 'Mesh size for core density must be equal or larger',ch10,&
2052 : 0 : & 'than mesh size for PAW augmentation regions !',ch10,&
2053 : 0 : & 'Action : check your pseudopotential (increase Ncore meshSize).'
2054 : 0 : LIBPAW_ERROR(msg)
2055 : : end if
2056 : :
2057 : : !Are radial meshes for (t)Nvale and Phi compatibles ?
2058 [ + + - + ]: 549 : if ((pawtab%has_tvale==1).and.(vale_mesh%rmax<pawrad%rmax)) then
2059 : : write(msg, '(a,a,a)' )&
2060 : 0 : & 'Rmax for tNvale < Rmax for Phi !',ch10,&
2061 : 0 : & 'Action : check your pseudopotential (increase tNvale meshSize).'
2062 : 0 : LIBPAW_ERROR(msg)
2063 : : end if
2064 : :
2065 : : !Is PAW radius included inside radial mesh ?
2066 [ - + ]: 549 : if (pawtab%rpaw>pawrad%rmax+tol8) then
2067 : : write(msg, '(a,a,a)' )&
2068 : 0 : & 'Radius of PAW sphere is outside the radial mesh !',ch10,&
2069 : 0 : & 'Action: check your pseudopotential file.'
2070 : 0 : LIBPAW_ERROR(msg)
2071 : : end if
2072 : :
2073 : : !Max. radius of mesh for Vloc has to be "small" in order to avoid numeric noise ?
2074 [ + + ]: 549 : if (vloc_mesh%rmax>rm_vloc) then
2075 : 281 : msz_tmp=pawrad_ifromr(vloc_mesh,rm_vloc);mst_tmp=vloc_mesh%mesh_type
2076 : 281 : rstep_tmp=vloc_mesh%rstep;lstep_tmp=vloc_mesh%lstep
2077 : 281 : call pawrad_free(vloc_mesh)
2078 : : call pawrad_init(vloc_mesh,mesh_size=msz_tmp,mesh_type=mst_tmp,&
2079 : 281 : & rstep=rstep_tmp,lstep=lstep_tmp,r_for_intg=rm_vloc)
2080 : 281 : write(msg, '(a,i4,a)' ) ' Mesh size for Vloc has been set to ', &
2081 : 562 : & vloc_mesh%mesh_size,' to avoid numerical noise.'
2082 : 281 : call wrtout(std_out,msg,'COLL')
2083 : 281 : call wrtout(ab_out,msg,'COLL')
2084 : : end if
2085 : :
2086 : : !This test has been disable... MT 2006-25-10
2087 : : !For Simpson rule, it is better to have odd mesh sizes
2088 : : !itest=0
2089 : : !do imsh=1,nmesh
2090 : : !if (mod(radmesh(imsh)%mesh_size,2)==0.and.radmesh(imsh)%mesh_type==1) itest=1
2091 : : !end do
2092 : : !if (itest==1) then
2093 : : ! write(msg, '(5a)' ) &
2094 : : !& 'Regular radial meshes should have odd number of points ',ch10,&
2095 : : !& 'for better accuracy of integration sheme (Simpson rule).',ch10,&
2096 : : !& 'Althought it''s not compulsory, you should change mesh sizes in psp file.'
2097 : : ! LIBPAW_WARNING(msg)
2098 : : !end if
2099 : :
2100 : : !Test the compatibilty between Rpaw and mesh for (t)Phi
2101 [ + + ]: 549 : if (pspversion>=3) then
2102 : 515 : itest=pawrad_ifromr(radmesh(imainmesh),pawtab%rpaw)
2103 : : ! This test has been disable... MT 2015-02-12
2104 : : ! if (itest+2>radmesh(imainmesh)%mesh_size) then
2105 : : ! write(msg, '(9a)' ) &
2106 : : !& 'Atomic data could produce inaccurate results:',ch10,&
2107 : : !& 'Wavefunctions and pseudo-wavefunctions should',ch10,&
2108 : : !& 'be given on a radial mesh larger than the PAW',ch10,&
2109 : : !& 'spheres (at least 2 additional points) !',ch10,&
2110 : : !& 'Action: check your pseudopotential file.'
2111 : : ! LIBPAW_WARNING(msg)
2112 : : ! end if
2113 [ + + ]: 515 : if (abs(pawtab%rpaw-radmesh(imainmesh)%rad(itest))<tol8) itest=itest-1
2114 : 515 : ib=0;isnotzero=0
2115 [ + - + + ]: 2881 : do while ((isnotzero==0).and.(ib<pawtab%basis_size))
2116 : 2366 : ib=ib+1;ir=itest
2117 [ + + ]: 15907 : do while ((isnotzero==0).and.(ir<pawtab%mesh_size))
2118 [ - + ]: 15392 : ir=ir+1;if (abs(pawtab%phi(ir,ib)-pawtab%tphi(ir,ib))>tol8) isnotzero=1
2119 : : end do
2120 : : end do
2121 [ - + ]: 515 : if (isnotzero>0) then
2122 : : write(msg, '(7a)' )&
2123 : 0 : & 'Atomic data are inconsistent:',ch10,&
2124 : 0 : & 'For r>=r_paw, pseudo wavefunctions are not',ch10,&
2125 : 0 : & 'equal to wave functions (Phi(r)/=tPhi(r)) !',ch10,&
2126 : 0 : & 'Action: check your pseudopotential file.'
2127 : 0 : LIBPAW_ERROR(msg)
2128 : : end if
2129 : : else
2130 : : ! For compatibility reasons set PAW radius at the end of mesh (older versions)
2131 [ + - ]: 34 : if (pawtab%rpaw/=pawrad%rmax) then
2132 : 34 : msz_tmp=pawrad%mesh_size;mst_tmp=pawrad%mesh_type
2133 : 34 : rstep_tmp=pawrad%rstep;lstep_tmp=pawrad%lstep
2134 : 34 : call pawrad_free(pawrad)
2135 : 34 : call pawrad_init(pawrad,mesh_size=msz_tmp,mesh_type=mst_tmp,rstep=rstep_tmp,lstep=lstep_tmp)
2136 : 34 : pawtab%rpaw=pawrad%rmax
2137 : : end if
2138 : : end if
2139 : : !If Vloc is a "Vbare" potential, it has to be localized inside PAW spheres
2140 [ + + + - ]: 549 : if (vlocopt==0.and.(vloc_mesh%rmax>pawtab%rpaw+tol10)) then
2141 [ - + ]: 10 : if(vlocr(pawrad_ifromr(vloc_mesh,pawtab%rpaw))>tol10) then
2142 : : write(msg, '(7a)' )&
2143 : 0 : & 'Atomic data are inconsistent:',ch10,&
2144 : 0 : & 'Local potential is a "Vbare" potential',ch10,&
2145 : 0 : & 'and is not localized inside PAW sphere !',ch10,&
2146 : 0 : & 'Vbare is set to zero if r>rpaw.'
2147 : 0 : LIBPAW_WARNING(msg)
2148 [ # # ]: 0 : do ir=pawrad_ifromr(vloc_mesh,pawtab%rpaw),vloc_mesh%mesh_size
2149 : 0 : vlocr(ir)=zero
2150 : : end do
2151 : : end if
2152 : : end if
2153 : :
2154 : : !==========================================================
2155 : : !Initializations
2156 : :
2157 : 549 : has_dij0=(allocated(pawtab%dij0))
2158 : :
2159 : : !Allocate/initialize some dummy variables
2160 : 549 : tmp_lmselect(1)=.true.
2161 : 549 : non_magnetic_xc=.false.
2162 [ + + ]: 549 : if (pawxcdev==0) then
2163 : 43 : pawang_tmp%l_size_max=1;pawang_tmp%angl_size=1;pawang_tmp%ylm_size=1
2164 : 43 : pawang_tmp%use_ls_ylm=0;pawang_tmp%gnt_option=0;pawang_tmp%ngnt=0;pawang_tmp%nsym=0
2165 [ - + ]: 43 : LIBPAW_ALLOCATE(pawang_tmp%angwgth,(1))
2166 : 43 : pawang_tmp%angwgth(1)=one
2167 [ - + ]: 43 : LIBPAW_ALLOCATE(pawang_tmp%anginit,(3,1))
2168 : 43 : pawang_tmp%anginit(1,1)=one
2169 [ + + ]: 129 : pawang_tmp%anginit(2:3,1)=zero
2170 [ - + ]: 43 : LIBPAW_ALLOCATE(pawang_tmp%ylmr,(1,1))
2171 : 43 : pawang_tmp%ylmr(1,1)=1._dp/sqrt(four_pi)
2172 [ - + ]: 43 : LIBPAW_ALLOCATE(pawang_tmp%ylmrgr,(9,1,1))
2173 [ + + ]: 430 : pawang_tmp%ylmrgr(1:9,1,1)=zero
2174 : : end if
2175 : :
2176 : : !==========================================================
2177 : : !Compute ffspl(q) (and derivatives)
2178 : :
2179 [ + + + + : 15688501 : ffspl=zero
+ + ]
2180 [ + - ]: 549 : if (mqgrid_ff>0) then
2181 : : call pawpsp_nl(ffspl,pawtab%indlmn,pawtab%lmn_size,lnmax,mqgrid_ff,qgrid_ff,&
2182 : 549 : & tproj_mesh,tproj)
2183 : : end if
2184 : :
2185 : : !==========================================================
2186 : : !Compute eventually compensation charge radius (i.e. radius for shape functions)
2187 : :
2188 [ + + + + ]: 549 : if (pawtab%shape_type>0.and.pawtab%rshp<1.d-8) then
2189 : 215 : pawtab%rshp=pawtab%rpaw
2190 [ + + ]: 334 : else if (pawtab%shape_type==-1) then
2191 : 3 : ir=pawrad_ifromr(radmesh(imainmesh),pawtab%rpaw)+1;isnotzero=0
2192 [ + + ]: 6 : do while ((isnotzero==0).and.(ir>1))
2193 : 3 : ir=ir-1;il=0
2194 [ - + ]: 6 : do while ((isnotzero==0).and.(il<pawtab%l_size))
2195 [ + - ]: 3 : il=il+1;if (pawtab%shapefunc(ir,il)>tol16) isnotzero=1
2196 : : end do
2197 : : end do
2198 : 3 : ir=min(ir+1,pawrad_ifromr(radmesh(imainmesh),pawtab%rpaw))
2199 : 3 : pawtab%rshp=radmesh(imainmesh)%rad(ir)
2200 [ + + ]: 18 : do il=1,pawtab%l_size
2201 [ - + ]: 18 : if (pawtab%shapefunc(ir,il)>tol6) then
2202 : : write(msg, '(a,a,a)' )&
2203 : 0 : & 'Shape function is not zero at PAW radius !',ch10,&
2204 : 0 : & 'Action: check your pseudopotential file.'
2205 : 0 : LIBPAW_ERROR(msg)
2206 : : end if
2207 : : end do
2208 : : end if
2209 : :
2210 : : !==========================================================
2211 : : !Compute compensation charge density (nhat)
2212 : : !Add it to pseudo valence density
2213 : :
2214 [ + + ]: 549 : if (pawtab%has_tvale==1) then
2215 : 405 : msz=vale_mesh%mesh_size
2216 [ - + + - : 1215 : LIBPAW_ALLOCATE(nhat,(msz))
+ - + - -
+ - + ]
2217 : : ! A-Has to compute norm of nhat (Int[n-tild_n])
2218 : 405 : testval=(abs(tnvale(msz))<tol9)
2219 : : ! A1-If tnvale is not given with enough points,
2220 : : ! try to compute it from rhoij0 and tphi
2221 [ + + ]: 405 : if (.not.testval) then
2222 : 60 : msz1=pawtab%mesh_size
2223 : : ! Compute n and tild_n from phi and tphi
2224 [ - + + - : 180 : LIBPAW_ALLOCATE(work1,(msz1))
+ - + - -
+ - + ]
2225 [ - + + - : 120 : LIBPAW_ALLOCATE(work2,(msz1))
- + - + ]
2226 [ + + ]: 40211 : work1=zero
2227 [ + + ]: 40211 : work2=zero
2228 [ + + ]: 768 : do jlmn=1,pawtab%lmn_size
2229 : 708 : j0lmn=jlmn*(jlmn-1)/2;jln=pawtab%indlmn(5,jlmn)
2230 [ + + ]: 6708 : do ilmn=1,jlmn
2231 : 5940 : klmn=j0lmn+ilmn;iln=pawtab%indlmn(5,ilmn)
2232 [ + + ]: 5940 : yp1=two;if (ilmn==jlmn) yp1=one
2233 : : work1(1:msz1)=work1(1:msz1)+yp1*pawtab%rhoij0(klmn) &
2234 [ + + ]: 4888953 : & *pawtab% phi(1:msz1,iln)*pawtab% phi(1:msz1,jln)
2235 : : work2(1:msz1)=work2(1:msz1)+yp1*pawtab%rhoij0(klmn) &
2236 [ + + ]: 4889661 : & *pawtab%tphi(1:msz1,iln)*pawtab%tphi(1:msz1,jln)
2237 : : end do
2238 : : end do
2239 : : ! Spline tnvale onto pawrad if needed
2240 [ - + + - : 120 : LIBPAW_ALLOCATE(nwk,(msz1))
- + - + ]
2241 [ + - + - : 60 : if ((vale_mesh%mesh_type/=pawrad%mesh_type).or.(vale_mesh%rstep/=pawrad%rstep).or.&
- + ]
2242 : : & (vale_mesh%lstep/=pawrad%lstep)) then
2243 [ # # # # : 0 : LIBPAW_ALLOCATE(work3,(vale_mesh%mesh_size))
# # # # ]
2244 : 0 : call bound_deriv(tnvale(1:vale_mesh%mesh_size),vale_mesh,vale_mesh%mesh_size,yp1,ypn)
2245 : 0 : call paw_spline(vale_mesh%rad,tnvale,vale_mesh%mesh_size,yp1,ypn,work3)
2246 : 0 : call paw_splint(vale_mesh%mesh_size,vale_mesh%rad,tnvale,work3,msz1,pawrad%rad(1:msz1),nwk(1:msz1))
2247 [ # # ]: 0 : LIBPAW_DEALLOCATE(work3)
2248 : : else
2249 [ + + ]: 40211 : nwk(1:msz1)=tnvale(1:msz1)
2250 : : end if
2251 : : ! Compare tild_n and tnvale (inside aug. region)
2252 [ + - - + : 40271 : if (maxval(abs((nwk(1:msz1)*four_pi*pawrad%rad(1:msz1)**2)-work2(1:msz1)))<tol6) then
- - + + +
+ ]
2253 : : ! If equality then compute Int[n-tild_n]
2254 [ - + + + ]: 36422 : work1=work1-work2
2255 : 52 : call simp_gen(qq,work1,pawrad)
2256 : 52 : qq=qq/four_pi
2257 : : else
2258 : : ! If not equality, will use tnvale
2259 : 8 : testval=.true.
2260 : : write(msg, '(3a)' ) &
2261 : 8 : & 'Valence density is not given with enough points',ch10,&
2262 : 16 : & 'in psp file. Some charge estimations will be coarse.'
2263 : 8 : LIBPAW_WARNING(msg)
2264 : : end if
2265 [ - + ]: 60 : LIBPAW_DEALLOCATE(nwk)
2266 [ - + ]: 60 : LIBPAW_DEALLOCATE(work1)
2267 [ - + ]: 60 : LIBPAW_DEALLOCATE(work2)
2268 : : end if
2269 : : ! A2-If tnvale is given with enough points, use it
2270 [ + + ]: 405 : if (testval) then
2271 [ + + ]: 605078 : nhat(1:msz)=tnvale(1:msz)*vale_mesh%rad(1:msz)**2
2272 : 353 : call simp_gen(qq,nhat,vale_mesh)
2273 : 353 : qq=zion/four_pi-qq
2274 : : end if
2275 : : ! B-Compute nhat and add it to pseudo valence density
2276 : 405 : call atompaw_shpfun(0,vale_mesh,intg,pawtab,nhat)
2277 [ + + ]: 647815 : nhat(1:msz)=qq*nhat(1:msz)
2278 [ + + ]: 647815 : tnvale(1:msz)=tnvale(1:msz)+nhat(1:msz)
2279 : : end if
2280 : :
2281 : : !==========================================================
2282 : : !If Vloc potential is in "Vbare" format, translate it into VH(tnzc) format
2283 : :
2284 [ + + ]: 549 : if (vlocopt==0) then
2285 : 10 : write(msg,'(a)') ' Local potential is in "Vbare" format... '
2286 : 10 : call wrtout(ab_out,msg,'COLL')
2287 : 10 : call wrtout(std_out, msg,'COLL')
2288 : 10 : msz=core_mesh%mesh_size
2289 [ - + + - : 30 : LIBPAW_ALLOCATE(r2k,(msz))
+ - + - -
+ - + ]
2290 : 10 : call atompaw_shpfun(0,core_mesh,intg,pawtab,r2k)
2291 [ + + ]: 5078 : r2k(1:msz)=r2k(1:msz)*core_mesh%rad(1:msz)**2
2292 : : ! Compute VH[4pi.r2.n(r)=4pi.r2.tncore(r)+(Qcore-Z).r2.k(r)]
2293 [ - + + - : 20 : LIBPAW_ALLOCATE(nwk,(core_mesh%mesh_size))
- + - + -
+ ]
2294 [ - + + - : 20 : LIBPAW_ALLOCATE(vh,(core_mesh%mesh_size))
- + - + ]
2295 [ + + ]: 10 : if (core_mesh%mesh_type==5) then
2296 [ + + ]: 902 : nwk(1:msz)=tncore(1:msz)*four_pi*core_mesh%rad(1:msz)**2
2297 : 2 : call simp_gen(qcore,nwk,core_mesh)
2298 : 2 : qcore=znucl-zion-qcore
2299 : : else
2300 [ + + ]: 4176 : nwk(1:msz)=(ncore(1:msz)-tncore(1:msz))*four_pi*core_mesh%rad(1:msz)**2
2301 : 8 : ib=1
2302 [ + + ]: 4168 : do ir=msz,2,-1
2303 [ + + ]: 4168 : if(abs(nwk(ir))<tol14)ib=ir
2304 : : end do
2305 : 8 : call simp_gen(qcore,nwk,core_mesh,r_for_intg=core_mesh%rad(ib))
2306 [ + + ]: 4176 : nwk(1:msz)=tncore(1:msz)*four_pi*core_mesh%rad(1:msz)**2
2307 : : end if
2308 [ + + ]: 5078 : nwk(1:msz)=nwk(1:msz)+r2k(1:msz)*(qcore-znucl)
2309 : 10 : call poisson(nwk,0,core_mesh,vh)
2310 [ + + ]: 5068 : vh(2:msz)=vh(2:msz)/core_mesh%rad(2:msz)
2311 : 10 : call pawrad_deducer0(vh,msz,core_mesh)
2312 : :
2313 [ - + ]: 10 : LIBPAW_DEALLOCATE(nwk)
2314 : : ! Eventually spline Vbare
2315 [ - + + - : 20 : LIBPAW_ALLOCATE(vbare,(core_mesh%mesh_size))
- + - + ]
2316 : : if ((core_mesh%mesh_type/=vloc_mesh%mesh_type).or.&
2317 [ + - + - : 10 : & (core_mesh%rstep /=vloc_mesh%rstep) .or.&
- + ]
2318 : : & (core_mesh%lstep /=vloc_mesh%lstep)) then
2319 [ # # ]: 0 : msz=core_mesh%mesh_size;if (vloc_mesh%rmax<core_mesh%rmax) msz=pawrad_ifromr(core_mesh,vloc_mesh%rmax)
2320 : 0 : call bound_deriv(vlocr(1:vloc_mesh%mesh_size),vloc_mesh,vloc_mesh%mesh_size,yp1,ypn)
2321 [ # # # # : 0 : LIBPAW_ALLOCATE(work1,(vloc_mesh%mesh_size))
# # # # #
# # # #
# ]
2322 [ # # # # : 0 : LIBPAW_ALLOCATE(work2,(vloc_mesh%mesh_size))
# # # # ]
2323 : 0 : call paw_spline(vloc_mesh%rad,vlocr,vloc_mesh%mesh_size,yp1,ypn,work1)
2324 : 0 : call paw_splint(vloc_mesh%mesh_size,vloc_mesh%rad,vlocr,work1,msz,core_mesh%rad(1:msz),vbare)
2325 [ # # ]: 0 : LIBPAW_DEALLOCATE(work1)
2326 [ # # ]: 0 : LIBPAW_DEALLOCATE(work2)
2327 : : else
2328 : 10 : msz=min(core_mesh%mesh_size,vloc_mesh%mesh_size)
2329 [ + + ]: 5062 : vbare(1:msz)=vlocr(1:msz)
2330 : : end if
2331 : : ! Build VH(tnzc) from Vbare
2332 [ + + ]: 5062 : vlocr(1:msz)=vbare(1:msz)+vh(1:msz)
2333 [ + + ]: 10 : if(vloc_mesh%mesh_size>msz)then
2334 [ + + ]: 392 : vlocr(msz+1:vloc_mesh%mesh_size)=vh(msz)*vloc_mesh%rad(msz)/vloc_mesh%rad(msz+1:vloc_mesh%mesh_size)
2335 : : end if
2336 [ - + ]: 10 : LIBPAW_DEALLOCATE(vbare)
2337 [ - + ]: 10 : LIBPAW_DEALLOCATE(vh)
2338 : :
2339 : : ! Compute <tPhi_i|VH(tnzc)|tPhi_j> and int[VH(tnzc)*Qijhat(r)dr] parts of Dij0
2340 : : ! Note: it is possible as core_mesh and radmesh(imainmesh) have the same steps
2341 [ - + ]: 10 : if (has_dij0) then
2342 : 0 : msz=radmesh(imainmesh)%mesh_size
2343 [ # # # # : 0 : LIBPAW_ALLOCATE(work1,(msz))
# # # # #
# # # #
# ]
2344 [ # # ]: 0 : work1(1:msz)=vlocr(1:msz)*r2k(1:msz)
2345 : 0 : call simp_gen(intvh,work1,radmesh(imainmesh))
2346 [ # # ]: 0 : do jlmn=1,pawtab%lmn_size
2347 : 0 : j0lmn=jlmn*(jlmn-1)/2;jlm=pawtab%indlmn(4,jlmn);jln=pawtab%indlmn(5,jlmn)
2348 [ # # ]: 0 : do ilmn=1,jlmn
2349 : 0 : klmn=j0lmn+ilmn;ilm=pawtab%indlmn(4,ilmn);iln=pawtab%indlmn(5,ilmn)
2350 [ # # ]: 0 : if (jlm==ilm) then
2351 : : work1(1:msz)=pawtab%tphi(1:msz,iln)*pawtab%tphi(1:msz,jln)*(vlocr(1:msz)-intvh) &
2352 [ # # ]: 0 : & -pawtab%phi (1:msz,iln)*pawtab%phi (1:msz,jln)*intvh
2353 : 0 : call simp_gen(intg,work1,radmesh(imainmesh))
2354 : 0 : pawtab%dij0(klmn)=pawtab%dij0(klmn)+intg
2355 : : end if
2356 : : end do
2357 : : end do
2358 [ # # ]: 0 : LIBPAW_DEALLOCATE(work1)
2359 : : end if
2360 [ - + ]: 10 : LIBPAW_DEALLOCATE(r2k)
2361 : : end if
2362 : :
2363 : : !==========================================================
2364 : : !If usexcnhat in psp file is different from usexcnhat chosen
2365 : : !by user, convert VH(tnzc) and Dij0
2366 : :
2367 [ + + ]: 549 : if (pawtab%usexcnhat==-1) then
2368 : 439 : pawtab%usexcnhat=usexcnhat
2369 [ + + ]: 110 : else if (usexcnhat/=pawtab%usexcnhat) then
2370 [ - + ]: 22 : if (pawtab%has_tvale==0) then
2371 : : write(msg, '(5a)' ) &
2372 : 0 : & 'It is only possible to modify the use of compensation charge density',ch10,&
2373 : 0 : & 'for a file format containing the pseudo valence density (format>=paw4 or XML)!',ch10,&
2374 : 0 : & 'Action: use usexcnhat=-1 in input file or change psp file format.'
2375 : 0 : LIBPAW_ERROR(msg)
2376 [ - + ]: 22 : else if (usekden>=1) then
2377 : : write(msg, '(5a)' ) &
2378 : 0 : & 'It is not possible to modify the use of compensation charge density',ch10,&
2379 : 0 : & 'within the metaGGA XC functional (need valence kinetic density)!',ch10,&
2380 : 0 : & 'Action: use usexcnhat=-1 in input file or change psp file format.'
2381 : 0 : LIBPAW_ERROR(msg)
2382 : : else
2383 : 22 : msz=vloc_mesh%mesh_size
2384 : : ! Retrieve tvale and nhat onto vloc mesh
2385 [ - + + - : 66 : LIBPAW_ALLOCATE(nwk,(msz))
+ - + - -
+ - + -
+ ]
2386 [ - + + - : 44 : LIBPAW_ALLOCATE(ncorwk,(msz))
- + - + ]
2387 [ - + + - : 44 : LIBPAW_ALLOCATE(nhatwk,(msz))
- + - + ]
2388 [ + + + + : 41800 : nwk=zero;ncorwk=zero;nhatwk=zero
+ + ]
2389 : : if ((core_mesh%mesh_type/=vloc_mesh%mesh_type).or.&
2390 [ + - + - : 22 : & (core_mesh%rstep /=vloc_mesh%rstep) .or.&
- + ]
2391 : : & (core_mesh%lstep /=vloc_mesh%lstep)) then
2392 [ # # # # : 0 : LIBPAW_ALLOCATE(work1,(core_mesh%mesh_size))
# # # # #
# # # #
# ]
2393 [ # # ]: 0 : msz1=msz;if (core_mesh%rmax<vloc_mesh%rmax) msz1=pawrad_ifromr(vloc_mesh,core_mesh%rmax)
2394 : 0 : call bound_deriv(tncore(1:core_mesh%mesh_size),core_mesh,core_mesh%mesh_size,yp1,ypn)
2395 : 0 : call paw_spline(core_mesh%rad,tncore,core_mesh%mesh_size,yp1,ypn,work1)
2396 : 0 : call paw_splint(core_mesh%mesh_size,core_mesh%rad,tncore,work1,msz1,vloc_mesh%rad(1:msz1),ncorwk(1:msz1))
2397 [ # # ]: 0 : LIBPAW_DEALLOCATE(work1)
2398 : : else
2399 : 22 : msz1=min(core_mesh%mesh_size,msz)
2400 [ + + ]: 13052 : ncorwk(1:msz1)=tncore(1:msz1)
2401 : : end if
2402 : : if ((vale_mesh%mesh_type/=vloc_mesh%mesh_type).or.&
2403 [ + - + - : 22 : & (vale_mesh%rstep /=vloc_mesh%rstep) .or.&
- + ]
2404 : : & (vale_mesh%lstep /=vloc_mesh%lstep)) then
2405 [ # # # # : 0 : LIBPAW_ALLOCATE(work1,(vale_mesh%mesh_size))
# # # # #
# # # #
# ]
2406 [ # # ]: 0 : msz1=msz;if (vale_mesh%rmax<vloc_mesh%rmax) msz1=pawrad_ifromr(vloc_mesh,vale_mesh%rmax)
2407 : 0 : call bound_deriv(tnvale(1:vale_mesh%mesh_size),vale_mesh,vale_mesh%mesh_size,yp1,ypn)
2408 : 0 : call paw_spline(vale_mesh%rad,tnvale,vale_mesh%mesh_size,yp1,ypn,work1)
2409 : 0 : call paw_splint(vale_mesh%mesh_size,vale_mesh%rad,tnvale,work1,msz1,vloc_mesh%rad(1:msz1),nwk(1:msz1))
2410 : 0 : call bound_deriv(nhat(1:vale_mesh%mesh_size),vale_mesh,vale_mesh%mesh_size,yp1,ypn)
2411 : 0 : call paw_spline(vale_mesh%rad,nhat,vale_mesh%mesh_size,yp1,ypn,work1)
2412 : 0 : call paw_splint(vale_mesh%mesh_size,vale_mesh%rad,nhat,work1,msz1,vloc_mesh%rad(1:msz1),nhatwk(1:msz1))
2413 [ # # ]: 0 : LIBPAW_DEALLOCATE(work1)
2414 : : else
2415 : 22 : msz1=min(vale_mesh%mesh_size,msz)
2416 [ + + ]: 13948 : nwk (1:msz1)=tnvale(1:msz1)
2417 [ + + ]: 13948 : nhatwk(1:msz1)=nhat (1:msz1)
2418 : : end if
2419 : :
2420 [ - + + + ]: 13970 : nwk=nwk-nhatwk
2421 [ + + + + ]: 27874 : nwk=sqrt(four_pi)*nwk;nhatwk=sqrt(four_pi)*nhatwk ! 0th-order moment of densities
2422 : :
2423 : : ! Compute Vxc without nhat (vxc1) and with nhat (vxc2)
2424 : 22 : nspden=1
2425 : : #if defined LIBPAW_HAVE_LIBXC
2426 [ + + ]: 22 : if (ixc<0) nspden=libxc_functionals_nspin()
2427 : : #endif
2428 [ + + ]: 22 : if (ixc<0) then
2429 [ - + + - : 6 : LIBPAW_ALLOCATE(vxc1,(msz*nspden))
+ - + - -
+ - + ]
2430 [ - + + - : 4 : LIBPAW_ALLOCATE(vxc2,(msz*nspden))
- + - + ]
2431 [ - + + - : 4 : LIBPAW_ALLOCATE(work1,(msz))
- + - + -
+ ]
2432 [ - + + - : 4 : LIBPAW_ALLOCATE(work2,(msz*nspden))
- + - + ]
2433 [ - + + - : 4 : LIBPAW_ALLOCATE(work3,(msz*nspden))
- + - + ]
2434 : 2 : tmp1 => work1
2435 [ + + ]: 2666 : work2(1:msz)=nwk
2436 [ + + ]: 2666 : work3(1:msz)=nhatwk
2437 [ + - + + ]: 2666 : if (nspden==2) work2(msz+1:2*msz)=half*nwk
2438 [ + - + + ]: 2666 : if (nspden==2) work3(msz+1:2*msz)=half*nhatwk
2439 [ + - ]: 2 : if (pawxcdev/=0) then
2440 : : call pawxcm(ncorwk,yp1,ypn,yp2,0,hyb_mixing,ixc,work1,1,tmp_lmselect,work3,0,non_magnetic_xc,msz,nspden,5,&
2441 : 2 : & pawang_tmp,vloc_mesh,pawxcdev,work2,pawtab%usetcore,0,vxc1,xclevel,xc_denpos,my_el_temp)
2442 : : call pawxcm(ncorwk,yp1,ypn,yp2,0,hyb_mixing,ixc,work1,1,tmp_lmselect,work3,0,non_magnetic_xc,msz,nspden,5,&
2443 : 2 : & pawang_tmp,vloc_mesh,pawxcdev,work2,pawtab%usetcore,2,vxc2,xclevel,xc_denpos,my_el_temp)
2444 [ + + + + ]: 10658 : vxc1=vxc1/sqrt(four_pi);vxc2=vxc2/sqrt(four_pi) ! Deduce Vxc from its first moment
2445 : : else
2446 : : call pawxc(ncorwk,yp1,ypn,yp2,hyb_mixing,ixc,work1,tmp1,1,tmp_lmselect,work3,0,0,non_magnetic_xc,msz,nspden,5,&
2447 [ # # ]: 0 : & pawang_tmp,vloc_mesh,work2,pawtab%usetcore,0,vxc1,xclevel,xc_denpos,my_el_temp)
2448 : : call pawxc(ncorwk,yp1,ypn,yp2,hyb_mixing,ixc,work1,tmp1,1,tmp_lmselect,work3,0,0,non_magnetic_xc,msz,nspden,5,&
2449 [ # # ]: 0 : & pawang_tmp,vloc_mesh,work2,pawtab%usetcore,2,vxc2,xclevel,xc_denpos,my_el_temp)
2450 : : end if
2451 [ - + ]: 2 : LIBPAW_DEALLOCATE(nwk)
2452 [ - + ]: 2 : LIBPAW_DEALLOCATE(ncorwk)
2453 [ - + ]: 2 : LIBPAW_DEALLOCATE(nhatwk)
2454 [ - + ]: 2 : LIBPAW_DEALLOCATE(work1)
2455 [ - + ]: 2 : LIBPAW_DEALLOCATE(work2)
2456 [ - + ]: 2 : LIBPAW_DEALLOCATE(work3)
2457 : : else
2458 [ - + + - : 40 : LIBPAW_ALLOCATE(vxc1,(msz))
- + - + ]
2459 [ - + + - : 40 : LIBPAW_ALLOCATE(vxc2,(msz))
- + - + ]
2460 [ - + + - : 40 : LIBPAW_ALLOCATE(work1,(msz))
- + - + -
+ ]
2461 : 20 : tmp1 => work1
2462 [ + - ]: 20 : if (pawxcdev/=0) then
2463 : : call pawxcm(ncorwk,yp1,ypn,yp2,0,hyb_mixing,ixc,work1,1,tmp_lmselect,nhatwk,0,non_magnetic_xc,msz,1,5,&
2464 : 20 : & pawang_tmp,vloc_mesh,pawxcdev,nwk,pawtab%usetcore,0,vxc1,xclevel,xc_denpos,my_el_temp)
2465 : : call pawxcm(ncorwk,yp1,ypn,yp2,0,hyb_mixing,ixc,work1,1,tmp_lmselect,nhatwk,0,non_magnetic_xc,msz,1,5,&
2466 : 20 : & pawang_tmp,vloc_mesh,pawxcdev,nwk,pawtab%usetcore,2,vxc2,xclevel,xc_denpos,my_el_temp)
2467 [ + + + + ]: 22544 : vxc1=vxc1/sqrt(four_pi);vxc2=vxc2/sqrt(four_pi) ! Deduce Vxc from its first moment
2468 : : else
2469 : : call pawxc(ncorwk,yp1,ypn,yp2,hyb_mixing,ixc,work1,tmp1,1,tmp_lmselect,nhatwk,0,0,non_magnetic_xc,msz,1,5,&
2470 [ # # ]: 0 : & pawang_tmp,vloc_mesh,nwk,pawtab%usetcore,0,vxc1,xclevel,xc_denpos,my_el_temp)
2471 : : call pawxc(ncorwk,yp1,ypn,yp2,hyb_mixing,ixc,work1,tmp1,1,tmp_lmselect,nhatwk,0,0,non_magnetic_xc,msz,1,5,&
2472 [ # # ]: 0 : & pawang_tmp,vloc_mesh,nwk,pawtab%usetcore,2,vxc2,xclevel,xc_denpos,my_el_temp)
2473 : : end if
2474 [ - + ]: 20 : LIBPAW_DEALLOCATE(nwk)
2475 [ - + ]: 20 : LIBPAW_DEALLOCATE(ncorwk)
2476 [ - + ]: 20 : LIBPAW_DEALLOCATE(nhatwk)
2477 [ - + ]: 20 : LIBPAW_DEALLOCATE(work1)
2478 : : endif
2479 : : ! Compute difference of XC potentials
2480 [ + + + - : 9956 : if (usexcnhat==0.and.pawtab%usexcnhat/=0) vxc1(1:msz)=vxc2(1:msz)-vxc1(1:msz)
+ + ]
2481 [ + + - + : 4014 : if (usexcnhat/=0.and.pawtab%usexcnhat==0) vxc1(1:msz)=vxc1(1:msz)-vxc2(1:msz)
+ + ]
2482 : : ! Modify VH(tnzc)
2483 [ + + ]: 13948 : vlocr(1:msz)=vlocr(1:msz)-vxc1(1:msz)
2484 [ + + ]: 22 : if (has_dij0) then
2485 : : ! Modify Dij0
2486 [ - + + - : 51 : LIBPAW_ALLOCATE(work2,(pawtab%lmn2_size))
+ - + - -
+ - + ]
2487 : : call atompaw_kij(pawtab%indlmn,work2,pawtab%lmn_size,ncore,0,0,pawtab,pawrad,&
2488 : 17 : & core_mesh,vloc_mesh,vxc1(1:msz),znucl)
2489 [ + - - + : 916 : pawtab%dij0=work2
- - + + ]
2490 [ - + ]: 17 : LIBPAW_DEALLOCATE(work2)
2491 : : end if
2492 [ - + ]: 22 : LIBPAW_DEALLOCATE(vxc1)
2493 [ - + ]: 22 : LIBPAW_DEALLOCATE(vxc2)
2494 : : end if ! has_tvale/=0
2495 : : end if
2496 [ + + ]: 549 : if (pawtab%usexcnhat==0) then
2497 : : write(msg,'(a)') &
2498 : 326 : & ' Compensation charge density is not taken into account in XC energy/potential'
2499 : 326 : call wrtout(ab_out,msg,'COLL')
2500 : 326 : call wrtout(std_out, msg,'COLL')
2501 : : end if
2502 [ + + ]: 549 : if (pawtab%usexcnhat==1) then
2503 : : write(msg,'(a)') &
2504 : 223 : & ' Compensation charge density is taken into account in XC energy/potential'
2505 : 223 : call wrtout(ab_out,msg,'COLL')
2506 : 223 : call wrtout(std_out, msg,'COLL')
2507 : : end if
2508 : :
2509 : : !==========================================================
2510 : : ! Calculate the coefficient beta = \int { vH[nZc](r) - vloc(r) } 4pi r^2 dr
2511 : : !
2512 [ - + + - : 1647 : LIBPAW_ALLOCATE(vhnzc,(core_mesh%mesh_size))
+ - + - -
+ - + -
+ ]
2513 [ - + + - : 1098 : LIBPAW_ALLOCATE(nwk,(core_mesh%mesh_size))
- + - + -
+ ]
2514 : : ! get vH[nZc]
2515 : 549 : call atompaw_vhnzc(ncore,core_mesh,vhnzc,znucl)
2516 : :
2517 : : !Transpose vlocr mesh into core mesh
2518 [ + + ]: 696794 : nwk(:)=zero
2519 : : if ((core_mesh%mesh_type/=vloc_mesh%mesh_type).or.&
2520 [ + - + - : 549 : & (core_mesh%rstep /=vloc_mesh%rstep) .or.&
- + ]
2521 : : & (core_mesh%lstep /=vloc_mesh%lstep)) then
2522 [ # # ]: 0 : msz=core_mesh%mesh_size;if (vloc_mesh%rmax<core_mesh%rmax) msz=pawrad_ifromr(core_mesh,vloc_mesh%rmax)
2523 : 0 : call bound_deriv(vlocr(1:vloc_mesh%mesh_size),vloc_mesh,vloc_mesh%mesh_size,yp1,ypn)
2524 [ # # # # : 0 : LIBPAW_ALLOCATE(work1,(vloc_mesh%mesh_size))
# # # # #
# # # #
# ]
2525 [ # # # # : 0 : LIBPAW_ALLOCATE(work2,(vloc_mesh%mesh_size))
# # # # ]
2526 : 0 : call paw_spline(vloc_mesh%rad,vlocr,vloc_mesh%mesh_size,yp1,ypn,work1)
2527 : 0 : call paw_splint(vloc_mesh%mesh_size,vloc_mesh%rad,vlocr,work1,msz,core_mesh%rad(1:msz),nwk)
2528 [ # # ]: 0 : LIBPAW_DEALLOCATE(work1)
2529 [ # # ]: 0 : LIBPAW_DEALLOCATE(work2)
2530 : : else
2531 : 549 : msz=min(core_mesh%mesh_size,vloc_mesh%mesh_size)
2532 [ + + ]: 637170 : nwk(1:msz)=vlocr(1:msz)
2533 : : end if
2534 : :
2535 : : !Difference
2536 [ + + ]: 637170 : nwk(1:msz)=vhnzc(1:msz)-nwk(1:msz)
2537 [ + + + + ]: 60173 : if (msz<core_mesh%mesh_size) nwk(msz+1:core_mesh%mesh_size)=zero
2538 : :
2539 : : !Perform the spherical integration
2540 [ + + ]: 637170 : nwk(1:msz)=nwk(1:msz)*four_pi*core_mesh%rad(1:msz)**2
2541 : :
2542 : 549 : call simp_gen(pawtab%beta,nwk,core_mesh)
2543 : :
2544 [ - + ]: 549 : LIBPAW_DEALLOCATE(vhnzc)
2545 [ - + ]: 549 : LIBPAW_DEALLOCATE(nwk)
2546 : :
2547 : : write(msg,'(a,e18.6)') &
2548 : 549 : & ' beta integral value: ',pawtab%beta
2549 : 549 : call wrtout(std_out,msg,'COLL')
2550 : :
2551 : :
2552 : : !==========================================================
2553 : : !Try to optimize CPU time:
2554 : : !If Vloc mesh size is big, spline Vloc into a smaller log. mesh
2555 : :
2556 : 549 : reduced_vloc=(vloc_mesh%mesh_size>int(reduced_mshsz))
2557 [ + + ]: 549 : if (reduced_vloc) then
2558 : 11 : msz=vloc_mesh%mesh_size
2559 : 11 : lstep_tmp=log(0.9999999_dp*vloc_mesh%rmax/reduced_rstep)/dble(reduced_mshsz-2)
2560 : : call pawrad_init(rvloc_mesh,mesh_size=reduced_mshsz,mesh_type=3,&
2561 : 11 : & rstep=reduced_rstep,lstep=lstep_tmp)
2562 [ - + - + ]: 11 : LIBPAW_ALLOCATE(rvlocr,(reduced_mshsz))
2563 : 11 : call bound_deriv(vlocr(1:msz),vloc_mesh,msz,yp1,ypn)
2564 [ - + + - : 33 : LIBPAW_ALLOCATE(work1,(msz))
+ - - + -
+ - + ]
2565 [ - + + - : 22 : LIBPAW_ALLOCATE(work2,(msz))
- + - + ]
2566 [ - + + - : 22 : LIBPAW_ALLOCATE(work3,(msz))
- + - + ]
2567 [ + + ]: 48161 : work3(1:msz)=vloc_mesh%rad(1:msz)
2568 : 11 : call paw_spline(work3,vlocr,msz,yp1,ypn,work1)
2569 : 11 : call paw_splint(msz,work3,vlocr,work1,reduced_mshsz,rvloc_mesh%rad,rvlocr)
2570 [ - + ]: 11 : LIBPAW_DEALLOCATE(work1)
2571 [ - + ]: 11 : LIBPAW_DEALLOCATE(work2)
2572 [ - + ]: 11 : LIBPAW_DEALLOCATE(work3)
2573 : : end if
2574 : :
2575 : : !Keep VH(tnZc) eventually in memory
2576 [ + - ]: 549 : if (pawtab%has_vhtnzc==1) then
2577 : : if ((reduced_vloc).and.(rvloc_mesh%mesh_type==pawrad%mesh_type)&
2578 [ + + - + : 549 : & .and.(rvloc_mesh%rstep==pawrad%rstep).and.(rvloc_mesh%lstep==pawrad%lstep)) then
- - - - ]
2579 [ # # # # : 0 : LIBPAW_ALLOCATE(pawtab%vhtnzc,(rvloc_mesh%mesh_size))
# # # # #
# # # #
# ]
2580 [ # # ]: 0 : pawtab%vhtnzc(:)=rvlocr(:)
2581 : 0 : pawtab%has_vhtnzc=2
2582 : : else if ((vloc_mesh%mesh_type==pawrad%mesh_type)&
2583 [ + - + - : 549 : & .and.(vloc_mesh%rstep==pawrad%rstep).and.(vloc_mesh%lstep==pawrad%lstep)) then
+ - ]
2584 [ - + + - : 1647 : LIBPAW_ALLOCATE(pawtab%vhtnzc,(size(vlocr)))
+ - + - -
+ - + -
+ ]
2585 [ + + ]: 754269 : pawtab%vhtnzc(:)=vlocr(:)
2586 : 549 : pawtab%has_vhtnzc=2
2587 : : else
2588 : 0 : msg = 'Vloc mesh is not right !'
2589 : 0 : LIBPAW_ERROR(msg)
2590 : : end if
2591 : : end if
2592 : :
2593 : : !==========================================================
2594 : : !Try to optimize CPU time:
2595 : : !If ncore mesh size is big, spline tncore into a smaller log. mesh
2596 : :
2597 [ + + - + ]: 549 : reduced_ncor=(core_mesh%mesh_size>int(reduced_mshsz)).and.(pawtab%usetcore/=0)
2598 : : if (reduced_ncor) then
2599 : 0 : msz=core_mesh%mesh_size
2600 : 0 : lstep_tmp=log(0.9999999_dp*core_mesh%rmax/reduced_rstep)/dble(reduced_mshsz-2)
2601 : : call pawrad_init(rcore_mesh,mesh_size=reduced_mshsz,mesh_type=3,&
2602 : 0 : & rstep=reduced_rstep,lstep=lstep_tmp)
2603 [ # # # # ]: 0 : LIBPAW_ALLOCATE(rtncor,(reduced_mshsz))
2604 : 0 : call bound_deriv(tncore(1:msz),core_mesh,msz,yp1,ypn)
2605 [ # # # # : 0 : LIBPAW_ALLOCATE(work1,(msz))
# # # # #
# ]
2606 [ # # # # : 0 : LIBPAW_ALLOCATE(work2,(msz))
# # # # ]
2607 [ # # # # : 0 : LIBPAW_ALLOCATE(work3,(msz))
# # # # ]
2608 [ # # ]: 0 : work3(1:msz)=core_mesh%rad(1:msz)
2609 : 0 : call paw_spline(work3,tncore,msz,yp1,ypn,work1)
2610 : 0 : call paw_splint(msz,work3,tncore,work1,reduced_mshsz,rcore_mesh%rad,rtncor)
2611 [ # # ]: 0 : LIBPAW_DEALLOCATE(work1)
2612 [ # # ]: 0 : LIBPAW_DEALLOCATE(work2)
2613 [ # # ]: 0 : LIBPAW_DEALLOCATE(work3)
2614 : : end if
2615 : :
2616 : : !==========================================================
2617 : : !Try to optimize CPU time:
2618 : : !If coretau mesh size is big, spline tcoretau into a smaller log. mesh
2619 : :
2620 : 549 : reduced_taucor=.false.
2621 [ + + ]: 549 : if (usekden>=1.and.present(tcoretau)) then
2622 [ - + - - ]: 14 : reduced_taucor=(coretau_mesh%mesh_size>int(reduced_mshsz)).and.(pawtab%usetcore/=0)
2623 : : if (reduced_taucor) then
2624 : 0 : msz=coretau_mesh%mesh_size
2625 : 0 : lstep_tmp=log(0.9999999_dp*coretau_mesh%rmax/reduced_rstep)/dble(reduced_mshsz-2)
2626 : : call pawrad_init(rcoretau_mesh,mesh_size=reduced_mshsz,mesh_type=3,&
2627 : 0 : & rstep=reduced_rstep,lstep=lstep_tmp)
2628 [ # # # # ]: 0 : LIBPAW_ALLOCATE(rttaucor,(reduced_mshsz))
2629 [ # # # # : 0 : call bound_deriv(tcoretau(1:msz),coretau_mesh,msz,yp1,ypn)
# # ]
2630 [ # # # # : 0 : LIBPAW_ALLOCATE(work1,(msz))
# # # # #
# # # ]
2631 [ # # # # : 0 : LIBPAW_ALLOCATE(work2,(msz))
# # # # ]
2632 [ # # # # : 0 : LIBPAW_ALLOCATE(work3,(msz))
# # # # ]
2633 [ # # ]: 0 : work3(1:msz)=coretau_mesh%rad(1:msz)
2634 [ # # # # : 0 : call paw_spline(work3,tcoretau,msz,yp1,ypn,work1)
# # # # ]
2635 [ # # # # : 0 : call paw_splint(msz,work3,tcoretau,work1,reduced_mshsz,rcoretau_mesh%rad,rttaucor)
# # # # ]
2636 [ # # ]: 0 : LIBPAW_DEALLOCATE(work1)
2637 [ # # ]: 0 : LIBPAW_DEALLOCATE(work2)
2638 [ # # ]: 0 : LIBPAW_DEALLOCATE(work3)
2639 : : end if
2640 : : end if
2641 : :
2642 : : !==========================================================
2643 : : !Try to optimize CPU time:
2644 : : !If vale mesh size is big, spline tnvale into a smaller log. mesh
2645 : :
2646 [ + + ]: 549 : if (pawtab%has_tvale==1) then
2647 : 405 : reduced_nval=(vale_mesh%mesh_size>int(reduced_mshsz))
2648 [ + + ]: 405 : if (reduced_nval) then
2649 : 7 : msz=vale_mesh%mesh_size
2650 : 7 : lstep_tmp=log(0.9999999_dp*vale_mesh%rmax/reduced_rstep)/dble(reduced_mshsz-2)
2651 : : call pawrad_init(rvale_mesh,mesh_size=reduced_mshsz,mesh_type=3,&
2652 : 7 : & rstep=reduced_rstep,lstep=lstep_tmp)
2653 [ - + - + ]: 7 : LIBPAW_ALLOCATE(rtnval,(reduced_mshsz))
2654 : 7 : call bound_deriv(tnvale(1:msz),vale_mesh,msz,yp1,ypn)
2655 [ - + + - : 21 : LIBPAW_ALLOCATE(work1,(msz))
+ - - + -
+ - + ]
2656 [ - + + - : 14 : LIBPAW_ALLOCATE(work2,(msz))
- + - + ]
2657 [ - + + - : 14 : LIBPAW_ALLOCATE(work3,(msz))
- + - + ]
2658 [ + + ]: 41877 : work3(1:msz)=vale_mesh%rad(1:msz)
2659 : 7 : call paw_spline(work3,tnvale,msz,yp1,ypn,work1)
2660 : 7 : call paw_splint(msz,work3,tnvale,work1,reduced_mshsz,rvale_mesh%rad,rtnval)
2661 [ - + ]: 7 : LIBPAW_DEALLOCATE(work1)
2662 [ - + ]: 7 : LIBPAW_DEALLOCATE(work2)
2663 [ - + ]: 7 : LIBPAW_DEALLOCATE(work3)
2664 : : end if
2665 : : else
2666 : : reduced_nval=.false.
2667 : : end if
2668 : : !==========================================================
2669 : : !Compute Vlspl(q) (and second derivative) from Vloc(r)
2670 : :
2671 : : !Compute Vlspl(q)=q^2.Vloc(q) from vloc(r)
2672 [ + - ]: 549 : if(mqgrid_vl>0) then
2673 [ + + ]: 549 : if (reduced_vloc) then
2674 : 11 : call pawpsp_lo(epsatm,mqgrid_vl,qgrid_vl,vlspl(:,1),rvloc_mesh,rvlocr,yp1,ypn,zion)
2675 : : else
2676 : 538 : call pawpsp_lo(epsatm,mqgrid_vl,qgrid_vl,vlspl(:,1),vloc_mesh,vlocr,yp1,ypn,zion)
2677 : : end if
2678 : : ! Compute second derivative of Vlspl(q)
2679 : 549 : call paw_spline(qgrid_vl,vlspl(:,1),mqgrid_vl,yp1,ypn,vlspl(:,2))
2680 : : else
2681 : : ! Only to compute epsatm
2682 : : epsatm=zero
2683 [ # # ]: 0 : if (reduced_vloc) then
2684 : 0 : call pawpsp_lo(epsatm,1,tmp_qgrid,tmp_q2vq,rvloc_mesh,rvlocr,yp1,ypn,zion)
2685 : : else
2686 : 0 : call pawpsp_lo(epsatm,1,tmp_qgrid,tmp_q2vq,vloc_mesh,vlocr,yp1,ypn,zion)
2687 : : end if
2688 : : end if
2689 : : !==========================================================
2690 : : !Compute tcorespl(q) (and second derivative) from tNcore(r)
2691 : :
2692 : 549 : pawtab%mqgrid=mqgrid_vl
2693 : 549 : xcccrc=core_mesh%rmax
2694 [ - + + - : 1647 : LIBPAW_ALLOCATE(pawtab%tcorespl,(pawtab%mqgrid,2))
+ - + - -
+ - + -
+ ]
2695 : :
2696 [ + - + + ]: 549 : if(mqgrid_vl>0.and.pawtab%usetcore/=0) then
2697 : : ! Compute tcorespl(q)=tNc(q) from tNcore(r)
2698 [ - + ]: 401 : if (reduced_ncor) then
2699 : 0 : call pawpsp_cg(pawtab%dncdq0,pawtab%d2ncdq0,mqgrid_vl,qgrid_vl,pawtab%tcorespl(:,1),rcore_mesh,rtncor,yp1,ypn)
2700 : : else
2701 : 401 : call pawpsp_cg(pawtab%dncdq0,pawtab%d2ncdq0,mqgrid_vl,qgrid_vl,pawtab%tcorespl(:,1),core_mesh,tncore,yp1,ypn)
2702 : : end if
2703 : : ! Compute second derivative of tcorespl(q)
2704 : 401 : call paw_spline(qgrid_vl,pawtab%tcorespl(:,1),mqgrid_vl,yp1,ypn,pawtab%tcorespl(:,2))
2705 : : else
2706 [ + + + + ]: 947812 : pawtab%tcorespl=zero
2707 : 148 : pawtab%dncdq0=zero
2708 : 148 : pawtab%d2ncdq0=zero
2709 : : end if
2710 : :
2711 : : !==========================================================
2712 : : !Compute tcoretauspl(q)
2713 : :
2714 [ + + ]: 549 : if (present(tcoretau)) then
2715 [ - + + - : 70 : LIBPAW_ALLOCATE(pawtab%tcoretauspl,(pawtab%mqgrid,2*usekden))
+ - - + +
- + - + -
- + - + -
+ ]
2716 [ + - ]: 14 : if (usekden==1) then
2717 [ - + ]: 14 : if (coretau_mesh%rmax/=xcccrc) then
2718 : : write(msg, '(a,a,a)' )&
2719 : 0 : & 'Core density and core kinetic density should be given on the same grid!',ch10,&
2720 : 0 : & 'Action : check your pseudopotential (increase tNvale meshSize).'
2721 : 0 : LIBPAW_ERROR(msg)
2722 : : end if
2723 [ + - ]: 14 : if(mqgrid_vl>0) then
2724 : : ! Compute tcorespl(q)=tNc(q) from tNcore(r)
2725 [ - + ]: 14 : if (reduced_taucor) then
2726 : 0 : call pawpsp_cg(pawtab%dtaucdq0,qq,mqgrid_vl,qgrid_vl,pawtab%tcoretauspl(:,1),rcoretau_mesh,rttaucor,yp1,ypn)
2727 : : else
2728 : 14 : call pawpsp_cg(pawtab%dtaucdq0,qq,mqgrid_vl,qgrid_vl,pawtab%tcoretauspl(:,1),coretau_mesh,tcoretau,yp1,ypn)
2729 : : end if
2730 : : ! Compute second derivative of tcorespl(q)
2731 : 14 : call paw_spline(qgrid_vl,pawtab%tcoretauspl(:,1),mqgrid_vl,yp1,ypn,pawtab%tcoretauspl(:,2))
2732 : : else
2733 [ # # # # ]: 0 : pawtab%tcoretauspl=zero
2734 : 0 : pawtab%dtaucdq0=zero
2735 : : end if
2736 : : end if
2737 : : end if
2738 : :
2739 : : !==========================================================
2740 : : !Compute tvalespl(q) (and second derivative) from tNvale(r)
2741 : :
2742 [ + + + - ]: 549 : if (pawtab%has_tvale/=0.and.mqgrid_vl>0) then
2743 [ - + + - : 1215 : LIBPAW_ALLOCATE(pawtab%tvalespl,(pawtab%mqgrid,2))
+ - + - -
+ - + -
+ ]
2744 [ + + ]: 405 : if (reduced_nval) then
2745 : 7 : call pawpsp_cg(pawtab%dnvdq0,d2nvdq0,mqgrid_vl,qgrid_vl,pawtab%tvalespl(:,1),rvale_mesh,rtnval,yp1,ypn)
2746 : 7 : pawtab%tnvale_mesh_size=rvale_mesh%mesh_size
2747 : : else
2748 : 398 : call pawpsp_cg(pawtab%dnvdq0,d2nvdq0,mqgrid_vl,qgrid_vl,pawtab%tvalespl(:,1),vale_mesh,tnvale,yp1,ypn)
2749 : 398 : pawtab%tnvale_mesh_size=vale_mesh%mesh_size
2750 : : end if
2751 : : ! Compute second derivative of tvalespl(q)
2752 : 405 : call paw_spline(qgrid_vl,pawtab%tvalespl(:,1),mqgrid_vl,yp1,ypn,pawtab%tvalespl(:,2))
2753 : : else
2754 : 144 : pawtab%dnvdq0=zero
2755 : 144 : pawtab%tnvale_mesh_size=0
2756 : : end if
2757 : :
2758 : : !==================================================
2759 : : !Compute Ex-correlation energy for the core density
2760 : :
2761 : 549 : nspden=1
2762 : : #if defined LIBPAW_HAVE_LIBXC
2763 [ + + ]: 549 : if (ixc<0) nspden=libxc_functionals_nspin()
2764 : : #endif
2765 : :
2766 [ - + + - : 1647 : LIBPAW_ALLOCATE(work1,(core_mesh%mesh_size*nspden))
+ - + - -
+ - + -
+ ]
2767 [ - + + - : 1098 : LIBPAW_ALLOCATE(work2,(core_mesh%mesh_size))
- + - + ]
2768 [ - + ]: 549 : LIBPAW_ALLOCATE(work3,(1))
2769 [ + + + + : 1462143 : work1(:)=zero;work2(:)=zero;work3(:)=zero
+ + ]
2770 : 549 : tmp1 => work1 ; tmp2 => work1
2771 : :
2772 [ + + ]: 549 : if (pawxcdev/=0) then
2773 : : 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,&
2774 [ - + ]: 506 : & nspden,4,pawang_tmp,core_mesh,pawxcdev,work1,1,0,tmp1,xclevel,xc_denpos,my_el_temp)
2775 : : else
2776 [ + + ]: 43 : if (present(tcoretau)) then
2777 : : 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,&
2778 [ - + - + ]: 14 : & nspden,4,pawang_tmp,core_mesh,tmp1,1,0,tmp2,xclevel,xc_denpos,my_el_temp,coretau=tcoretau,xc_taupos=my_xc_taupos)
2779 : : else
2780 : : 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,&
2781 [ - + - + ]: 29 : & nspden,4,pawang_tmp,core_mesh,tmp1,1,0,tmp2,xclevel,xc_denpos,my_el_temp)
2782 : : end if
2783 : : end if
2784 : :
2785 [ - + ]: 549 : LIBPAW_DEALLOCATE(work1)
2786 [ - + ]: 549 : LIBPAW_DEALLOCATE(work2)
2787 [ - + ]: 549 : LIBPAW_DEALLOCATE(work3)
2788 : :
2789 : : !==================================================
2790 : : !Compute Hartree kinetic energy for the core density and the nucleus
2791 : :
2792 : 549 : call atompaw_ehnzc(ncore,core_mesh,pawtab%ehnzc,znucl)
2793 : :
2794 : : !==================================================
2795 : : !Compute atomic contribution to Dij (Dij0)
2796 : : !if not already in memory
2797 : :
2798 [ + + + - ]: 549 : if ((.not.has_dij0).and.(pawtab%has_kij==2.or.pawtab%has_kij==-1)) then
2799 [ - + + - : 30 : LIBPAW_ALLOCATE(pawtab%dij0,(pawtab%lmn2_size))
+ - + - -
+ - + -
+ ]
2800 [ - + ]: 10 : if (reduced_vloc) then
2801 : : call atompaw_dij0(pawtab%indlmn,pawtab%kij,pawtab%lmn_size,ncore,0,pawtab,pawrad,core_mesh,&
2802 : 0 : & rvloc_mesh,rvlocr,znucl)
2803 : : else
2804 : : call atompaw_dij0(pawtab%indlmn,pawtab%kij,pawtab%lmn_size,ncore,0,pawtab,pawrad,core_mesh,&
2805 : 10 : & vloc_mesh,vlocr,znucl)
2806 : : end if
2807 : : has_dij0=.true.
2808 : : end if
2809 : : !==================================================
2810 : : !Compute kinetic operator contribution to Dij
2811 : :
2812 [ + + + - ]: 549 : if (pawtab%has_kij==1.and.has_dij0) then
2813 [ - + + - : 15 : LIBPAW_ALLOCATE(pawtab%kij,(pawtab%lmn2_size))
+ - + - -
+ - + -
+ ]
2814 : : call atompaw_kij(pawtab%indlmn,pawtab%kij,pawtab%lmn_size,ncore,0,1,pawtab,pawrad,core_mesh,&
2815 : 5 : & vloc_mesh,vlocr,znucl)
2816 : 5 : pawtab%has_kij=2
2817 : : end if
2818 : :
2819 : : !pawtab%has_kij=-1 means that kij does not have to be kept in memory
2820 [ + + ]: 549 : if (pawtab%has_kij==-1) then
2821 [ - + ]: 10 : LIBPAW_DEALLOCATE(pawtab%kij)
2822 : 10 : pawtab%has_kij=0
2823 : : end if
2824 : :
2825 : : !==========================================================
2826 : : !If projectors have to be kept in memory, we need
2827 : : !them on the main radial mesh (so, spline them if necessary)
2828 : :
2829 [ + + ]: 549 : if (pawtab%has_tproj>0) then
2830 : : if ((tproj_mesh%mesh_type/=pawrad%mesh_type).or.&
2831 [ + - + - : 3 : & (tproj_mesh%rstep /=pawrad%rstep).or.&
- + ]
2832 : : & (tproj_mesh%lstep /=pawrad%lstep)) then
2833 : 0 : ir=pawrad_ifromr(pawrad,tproj_mesh%rmax)
2834 : : call pawrad_init(tproj_mesh_new,mesh_size=ir,mesh_type=pawrad%mesh_type,&
2835 : 0 : & rstep=pawrad%rstep,lstep=pawrad%lstep)
2836 [ # # # # : 0 : LIBPAW_ALLOCATE(pawtab%tproj,(tproj_mesh_new%mesh_size,pawtab%basis_size))
# # # # #
# # # # #
# # # # ]
2837 [ # # # # : 0 : LIBPAW_ALLOCATE(work1,(tproj_mesh%mesh_size))
# # # # #
# # # ]
2838 [ # # ]: 0 : do ib=1,pawtab%basis_size
2839 : 0 : call bound_deriv(tproj(:,ib),tproj_mesh,tproj_mesh%mesh_size,yp1,ypn)
2840 : 0 : call paw_spline(tproj_mesh%rad,tproj(:,ib),tproj_mesh%mesh_size,yp1,ypn,work1)
2841 : : call paw_splint(tproj_mesh%mesh_size,tproj_mesh%rad,tproj(:,ib),work1,&
2842 : 0 : & tproj_mesh_new%mesh_size,tproj_mesh_new%rad,pawtab%tproj(:,ib))
2843 : : end do
2844 [ # # ]: 0 : LIBPAW_DEALLOCATE(work1)
2845 : 0 : call pawrad_free(tproj_mesh_new)
2846 : : else
2847 [ - + + - : 12 : LIBPAW_ALLOCATE(pawtab%tproj,(tproj_mesh%mesh_size,pawtab%basis_size))
- + + - +
- + - - +
- + - + ]
2848 [ + + + + ]: 60063 : pawtab%tproj(:,:)=tproj(:,:)
2849 : : end if
2850 : 3 : pawtab%has_tproj=2
2851 : : end if
2852 : :
2853 : : !==========================================================
2854 : : !Free temporary allocated space
2855 : :
2856 [ + + ]: 549 : if (pawtab%has_tvale==1) then
2857 [ - + ]: 405 : LIBPAW_DEALLOCATE(nhat)
2858 : : end if
2859 [ + + ]: 549 : if (reduced_vloc) then
2860 : 11 : call pawrad_free(rvloc_mesh)
2861 [ - + ]: 11 : LIBPAW_DEALLOCATE(rvlocr)
2862 : : end if
2863 [ - + ]: 549 : if (reduced_ncor) then
2864 : 0 : call pawrad_free(rcore_mesh)
2865 [ # # ]: 0 : LIBPAW_DEALLOCATE(rtncor)
2866 : : end if
2867 [ - + ]: 549 : if (reduced_taucor) then
2868 : 0 : call pawrad_free(rcoretau_mesh)
2869 [ # # ]: 0 : LIBPAW_DEALLOCATE(rttaucor)
2870 : : end if
2871 [ + + ]: 549 : if (reduced_nval) then
2872 : 7 : call pawrad_free(rvale_mesh)
2873 [ - + ]: 7 : LIBPAW_DEALLOCATE(rtnval)
2874 : : end if
2875 [ + + ]: 549 : if (pawxcdev==0) then
2876 [ - + ]: 43 : LIBPAW_DEALLOCATE(pawang_tmp%angwgth)
2877 [ - + ]: 43 : LIBPAW_DEALLOCATE(pawang_tmp%anginit)
2878 [ - + ]: 43 : LIBPAW_DEALLOCATE(pawang_tmp%ylmr)
2879 [ - + ]: 43 : LIBPAW_DEALLOCATE(pawang_tmp%ylmrgr)
2880 : : end if
2881 : :
2882 [ + + - + : 1098 : end subroutine pawpsp_calc
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + ]
2883 : : !!***
2884 : :
2885 : : !-------------------------------------------------------------------------
2886 : :
2887 : : !!****f* m_pawpsp/pawpsp_calc_d5
2888 : : !! NAME
2889 : : !! pawpsp_calc_d5
2890 : : !!
2891 : : !! FUNCTION
2892 : : !! Compute the first to the 5th derivatives of
2893 : : !! a given function in a pawrad mesh
2894 : : !!
2895 : : !! INPUTS
2896 : : !!
2897 : : !! OUTPUT
2898 : : !!
2899 : : !! SIDE EFFECTS
2900 : : !!
2901 : : !! NOTES
2902 : : !!
2903 : : !! SOURCE
2904 : :
2905 : 0 : subroutine pawpsp_calc_d5(mesh,mesh_size,tcoredens)
2906 : :
2907 : : !Arguments ------------------------------------
2908 : : integer,intent(in) :: mesh_size
2909 : : type(pawrad_type),intent(in) :: mesh
2910 : : real(dp),intent(inout) :: tcoredens(mesh_size,6)
2911 : :
2912 : : !Local variables-------------------------------
2913 : : integer,parameter :: it=1 !number of steps for smoothing function
2914 : : logical,parameter :: use_smooth=.true.
2915 : :
2916 : : ! *************************************************************************
2917 : :
2918 : : !calculate first derivative from density,
2919 : : !and store it
2920 : 0 : call nderiv_gen(tcoredens(:,2),tcoredens(:,1),mesh)
2921 : :
2922 : : !get second derivative from density, and store it
2923 : : call paw_spline(mesh%rad,tcoredens(:,1),mesh_size,&
2924 : 0 : & zero,zero,tcoredens(:,3))
2925 : :
2926 : : !smooth functions, to avoid numerical instabilities
2927 : : if(use_smooth) then
2928 : 0 : call paw_smooth(tcoredens(:,2),mesh_size,it)
2929 : 0 : call paw_smooth(tcoredens(:,3),mesh_size,it)
2930 : : end if
2931 : :
2932 : : !get third derivative from first derivative:
2933 : : call paw_spline(mesh%rad,tcoredens(:,2),mesh_size,&
2934 : 0 : & zero,zero,tcoredens(:,4))
2935 : :
2936 : : !get fourth derivative from second derivative:
2937 : : call paw_spline(mesh%rad,tcoredens(:,3),mesh_size,&
2938 : 0 : & zero,zero,tcoredens(:,5))
2939 : :
2940 : : !smooth 3rd and 4th order derivatives
2941 : : if(use_smooth) then
2942 : 0 : call paw_smooth(tcoredens(:,4),mesh_size,it)
2943 : 0 : call paw_smooth(tcoredens(:,5),mesh_size,it)
2944 : : end if
2945 : :
2946 : : !get fifth derivative from third derivative:
2947 : : call paw_spline(mesh%rad,tcoredens(:,4),mesh_size,&
2948 : 0 : & zero,zero,tcoredens(:,6))
2949 : :
2950 : : !smooth 5th order derivative
2951 : : if(use_smooth) then
2952 : 0 : call paw_smooth(tcoredens(:,6),mesh_size,it)
2953 : : end if
2954 : :
2955 : 0 : end subroutine pawpsp_calc_d5
2956 : : !!***
2957 : :
2958 : : !-------------------------------------------------------------------------
2959 : :
2960 : : !!****f* m_pawpsp/pawpsp_vhar2rho
2961 : : !! NAME
2962 : : !! pawpsp_vhar2rho
2963 : : !!
2964 : : !! FUNCTION
2965 : : !! gets rho(r) from v(r), solving the Poisson equation
2966 : : !! \lap v(r) = 4 \pi rho(r)
2967 : : !!
2968 : : !! INPUTS
2969 : : !! radmesh = radial grid (datastructure)
2970 : : !! vv(:)= potential
2971 : : !!
2972 : : !! OUTPUT
2973 : : !! rho(:)= density
2974 : : !!
2975 : : !! SIDE EFFECTS
2976 : : !!
2977 : : !! NOTES
2978 : : !!
2979 : : !! SOURCE
2980 : :
2981 [ # # # # ]: 0 : subroutine pawpsp_vhar2rho(radmesh,rho,vv)
2982 : :
2983 : : !Arguments ------------------------------------
2984 : : type(pawrad_type),intent(in) :: radmesh
2985 : : real(dp), intent(in) :: vv(:)
2986 : : real(dp), intent(out):: rho(:)
2987 : :
2988 : : !Local variables-------------------------------
2989 : : integer :: nr
2990 : 0 : real(dp) :: dfdr(radmesh%mesh_size),d2fdr(radmesh%mesh_size)
2991 : :
2992 : : ! *************************************************************************
2993 : :
2994 : 0 : nr=size(vv)
2995 [ # # ]: 0 : if (nr/=size(rho)) then
2996 : 0 : LIBPAW_BUG('wrong sizes!')
2997 : : end if
2998 : :
2999 : : !Laplacian =
3000 : : !\frac{\partial^2}{\partial r^2} + 2/r \frac{\partial}{\partial r}
3001 : :
3002 : : !Calculate derivatives
3003 : 0 : call nderiv_gen(dfdr(1:nr),vv,radmesh,der2=d2fdr(1:nr))
3004 : :
3005 [ # # ]: 0 : rho(2:nr)=d2fdr(2:nr) + 2._dp*dfdr(2:nr)/radmesh%rad(2:nr)
3006 [ # # # # : 0 : call pawrad_deducer0(rho,nr,radmesh)
# # # # #
# ]
3007 : :
3008 [ # # ]: 0 : rho(1:nr)=-rho(1:nr)/(4._dp*pi)
3009 : :
3010 : 0 : end subroutine pawpsp_vhar2rho
3011 : : !!***
3012 : :
3013 : : !-------------------------------------------------------------------------
3014 : :
3015 : : !!****f* m_pawpsp/pawpsp_wvl_calc
3016 : : !! NAME
3017 : : !! pawpsp_wvl_calc
3018 : : !!
3019 : : !! FUNCTION
3020 : : !! Performs tests and compute data related to pspcod=7 or 17 ("PAW pseudopotentials")
3021 : : !!
3022 : : !! INPUTS
3023 : : !! tnvale(vale_mesh%mesh_size)= pseudo valence density (+ nhat in output)
3024 : : !! usewvl= flag for wavelets method
3025 : : !! vale_mesh<type(pawrad_type)>= radial mesh for the valence density
3026 : : !! vloc_mesh<type(pawrad_type)>= radial mesh for the local potential
3027 : : !! vlocr(vloc_mesh%mesh_size)= local potential according to vlocopt.
3028 : : !!
3029 : : !! OUTPUT
3030 : : !! Sets pawtab%rholoc
3031 : : !!
3032 : : !! SIDE EFFECTS
3033 : : !! pawtab <type(pawtab_type)>= objects are modified
3034 : : !!
3035 : : !! NOTES
3036 : : !!
3037 : : !! SOURCE
3038 : :
3039 : 0 : subroutine pawpsp_wvl_calc(pawtab,tnvale,usewvl,vale_mesh,vloc_mesh,vlocr)
3040 : :
3041 : : !Arguments ------------------------------------
3042 : : !scalars
3043 : : integer,intent(in)::usewvl
3044 : : type(pawrad_type),intent(in) :: vale_mesh
3045 : : type(pawtab_type),intent(inout) :: pawtab
3046 : : type(pawrad_type),intent(in) ::vloc_mesh
3047 : :
3048 : : !arrays
3049 : : real(dp),intent(in) :: tnvale(vale_mesh%mesh_size*pawtab%has_tvale)
3050 : : real(dp),intent(in) :: vlocr(vloc_mesh%mesh_size)
3051 : :
3052 : :
3053 : : !Local variables ------------------------------
3054 : : !scalars
3055 : : integer :: msz
3056 : : character(len=500) :: msg
3057 : : !arrays
3058 : :
3059 : : ! *************************************************************************
3060 : :
3061 : : !If usewvl flag is on, we must have the pawtab%wvl pointer allocated
3062 [ # # ]: 0 : if (pawtab%has_wvl==0) then
3063 : 0 : msg='pawtab%has_wvl flag should be on o entry'
3064 : 0 : LIBPAW_BUG(msg)
3065 : : end if
3066 : 0 : call wvlpaw_allocate(pawtab%wvl)
3067 : :
3068 : : !==========================================================
3069 : : !Change mesh_size of tvalespl
3070 : : !Compute second derivative from tNvale(r)
3071 : :
3072 [ # # ]: 0 : if (pawtab%has_tvale/=0) then
3073 [ # # ]: 0 : if(usewvl==1) then
3074 [ # # ]: 0 : if(allocated(pawtab%tvalespl)) then
3075 : 0 : LIBPAW_DEALLOCATE(pawtab%tvalespl)
3076 : : end if
3077 [ # # # # : 0 : LIBPAW_ALLOCATE(pawtab%tvalespl,(vale_mesh%mesh_size,2))
# # # # #
# # # #
# ]
3078 : 0 : pawtab%tnvale_mesh_size=vale_mesh%mesh_size
3079 [ # # ]: 0 : pawtab%tvalespl(:,1)=tnvale
3080 : : ! Compute second derivative of tvalespl(r)
3081 : 0 : call paw_spline(vale_mesh%rad,pawtab%tvalespl(:,1),vale_mesh%mesh_size,zero,zero,pawtab%tvalespl(:,2))
3082 : : end if
3083 : : else
3084 : 0 : pawtab%dnvdq0=zero
3085 : 0 : pawtab%tnvale_mesh_size=0
3086 : : end if
3087 : :
3088 : : !==========================================================
3089 : : !Save rholoc:
3090 : : !Get local density from local potential
3091 : : !use the poisson eq.
3092 : 0 : msz=vloc_mesh%mesh_size
3093 : 0 : call wvlpaw_rholoc_free(pawtab%wvl%rholoc)
3094 [ # # # # : 0 : LIBPAW_ALLOCATE(pawtab%wvl%rholoc%d,(msz,4))
# # # # #
# # # #
# ]
3095 [ # # # # : 0 : LIBPAW_ALLOCATE(pawtab%wvl%rholoc%rad,(msz))
# # # # #
# # # #
# ]
3096 : 0 : pawtab%wvl%rholoc%msz=msz
3097 [ # # ]: 0 : pawtab%wvl%rholoc%rad(1:msz)=vloc_mesh%rad(1:msz)
3098 : :
3099 : : !get rho from v:
3100 : 0 : call pawpsp_vhar2rho(vloc_mesh,pawtab%wvl%rholoc%d(:,1),vlocr)
3101 : : !
3102 : : !get second derivative, and store it
3103 : : call paw_spline(pawtab%wvl%rholoc%rad,pawtab%wvl%rholoc%d(:,1),pawtab%wvl%rholoc%msz,&
3104 : 0 : & zero,zero,pawtab%wvl%rholoc%d(:,2))
3105 : :
3106 : : !save also vlocr:
3107 [ # # ]: 0 : pawtab%wvl%rholoc%d(:,3)=vlocr
3108 : :
3109 : : !get second derivative, and store it
3110 : : call paw_spline(pawtab%wvl%rholoc%rad,vlocr,pawtab%wvl%rholoc%msz,&
3111 : 0 : & zero,zero,pawtab%wvl%rholoc%d(:,4))
3112 : :
3113 : : !Test
3114 : : !do ii=1,pawtab%wvl%rholoc%msz
3115 : : !write(503,'(3(f16.10,x))')pawtab%wvl%rholoc%rad(ii),pawtab%wvl%rholoc%d(ii,1),pawtab%wvl%rholoc%d(ii,3)
3116 : : !end do
3117 : : !
3118 : : !Do splint
3119 : : !
3120 : : !nmesh=4000
3121 : : !rread1= (9.9979999d0/real(nmesh-1,dp)) ! 0.0025001d0 !step
3122 : : !allocate(raux1(nmesh),raux2(nmesh))
3123 : : !do ii=1,nmesh
3124 : : !raux1(ii)=rread1*real(ii-1,dp) !mesh
3125 : : !end do
3126 : : !call splint(pawtab%wvl%rholoc%msz,pawtab%wvl%rholoc%rad,pawtab%wvl%rholoc%d(:,1),pawtab%wvl%rholoc%d(:,2),&
3127 : : !& nmesh,raux1,raux2,ierr)
3128 : : !do ii=1,nmesh
3129 : : !write(401,'(10(f20.7,x))')raux1(ii),raux2(ii),raux2(ii)*raux1(ii)**2
3130 : : !end do
3131 : : !deallocate(raux1,raux2)
3132 : :
3133 : 0 : end subroutine pawpsp_wvl_calc
3134 : : !!***
3135 : :
3136 : : !-------------------------------------------------------------------------
3137 : :
3138 : : !!****f* m_pawpsp/pawpsp_17in
3139 : : !! NAME
3140 : : !! pawpsp_17in
3141 : : !!
3142 : : !! FUNCTION
3143 : : !! Initialize pspcod=17 ("PAW XML pseudopotentials"):
3144 : : !! continue to read the corresponding file and compute the form factors
3145 : : !!
3146 : : !! INPUTS
3147 : : !! ipsp= id in the array of the currently read pseudo.
3148 : : !! ixc=exchange-correlation choice from main routine data file
3149 : : !! lmax=value of lmax mentioned at the second line of the psp file
3150 : : !! lnmax=max. number of (l,n) components over all type of psps
3151 : : !! angular momentum of nonlocal pseudopotential
3152 : : !! mmax=max number of pts in real space grid (already read in the psp file header)
3153 : : !! mqgrid_ff=dimension of q (or G) grid for nl form factors (array ffspl)
3154 : : !! mqgrid_vl=dimension of q (or G) grid for Vloc (array vlspl)
3155 : : !! pawxcdev=choice of XC development (0=no dev. (use of angular mesh) ; 1 or 2=dev. on moments)
3156 : : !! pspheads= header of the current pseudopotential
3157 : : !! qgrid_ff(psps%mqgrid_ff)=values of q on grid from 0 to qmax (bohr^-1) for nl form factors
3158 : : !! qgrid_vl(psps%mqgrid_vl)=values of q on grid from 0 to qmax (bohr^-1) for Vloc
3159 : : !! xclevel= XC functional level
3160 : : !! xc_denpos= lowest allowed density (usually for the computation of the XC functionals)
3161 : : !! [xc_taupos]= lowest allowed kinetic energy density (for mGGA XC functionals)
3162 : : !! [el_temp]=electronic temperature (hartree)
3163 : : !! zion=nominal valence of atom as specified in psp file
3164 : : !! znucl=atomic number of atom as specified in input file to main routine
3165 : : !!
3166 : : !! OUTPUT
3167 : : !! epsatm=$ (4\pi)\int_0^\infty [r^2 (V(r)+\frac{Zv}{r}) dr]$(hartree)
3168 : : !! ffspl(psps%mqgrid_ff,2,psps%lnmax)=form factor f_l(q) and second derivative
3169 : : !! from spline fit for each angular momentum and each projector;
3170 : : !! pawrad <type(pawrad_type)>=paw radial mesh and related data
3171 : : !! pawtab <type(pawtab_type)>=paw tabulated starting data
3172 : : !! vlspl(psps%mqgrid_vl,2)=q^2 Vloc(q) and second derivatives from spline fit
3173 : : !! wvl_crmult,wvl_frmult= variables definining the fine and coarse grids in a wavelets calculation
3174 : : !! xcccrc=XC core correction cutoff radius (bohr) from psp file
3175 : : !!
3176 : : !! NOTES
3177 : : !! Spin-orbit not yet implemented (to be done)
3178 : : !! Comments:
3179 : : !! * mesh_type= type of radial mesh
3180 : : !! mesh_type=1 (regular grid): rad(i)=(i-1)*AA
3181 : : !! mesh_type=2 (logari. grid): rad(i)=AA*(exp[BB*(i-1)]-1)
3182 : : !! mesh_type=3 (logari. grid): rad(i>1)=AA*exp[BB*(i-2)] and rad(1)=0
3183 : : !! mesh_type=4 (logari. grid): rad(i)=-AA*ln[1-BB*(i-1)] with BB=1/n
3184 : : !! * radial shapefunction type
3185 : : !! shape_type=-1 ; gl(r)=numeric (read from psp file)
3186 : : !! shape_type= 1 ; gl(r)=k(r).r^l; k(r)=exp[-(r/sigma)**lambda]
3187 : : !! shape_type= 2 ; gl(r)=k(r).r^l; k(r)=[sin(pi*r/rshp)/(pi*r/rshp)]**2 if r<=rshp
3188 : : !! shape_type= 3 ; gl(r)=Alpha(1,l)*jl(q(1,l)*r)+Alpha(2,l)*jl(q(2,l)*r) for each l
3189 : : !!
3190 : : !! SOURCE
3191 : :
3192 : 316 : subroutine pawpsp_17in(epsatm,ffspl,icoulomb,ipsp,hyb_mixing,ixc,lmax,&
3193 : : & lnmax,mmax,mqgrid_ff,mqgrid_vl,pawpsp_header,pawrad,pawtab,&
3194 : 316 : & pawxcdev, qgrid_ff,qgrid_vl,usewvl,usexcnhat_in,vlspl,xcccrc,&
3195 : : & xclevel,xc_denpos,zion,znucl,&
3196 : : & xc_taupos,el_temp) ! Optional argument
3197 : :
3198 : : !Arguments ------------------------------------
3199 : : !scalars
3200 : : integer,intent(in) :: ipsp,ixc,lmax,lnmax,mqgrid_ff,mqgrid_vl,pawxcdev,usexcnhat_in
3201 : : integer,intent(inout) ::mmax
3202 : : integer,intent(in) :: xclevel,icoulomb,usewvl
3203 : : real(dp),intent(in) :: hyb_mixing,xc_denpos,zion,znucl
3204 : : real(dp),intent(in),optional :: xc_taupos,el_temp
3205 : : real(dp),intent(out) :: epsatm,xcccrc
3206 : : type(pawpsp_header_type),intent(in) :: pawpsp_header
3207 : : type(pawrad_type),intent(inout) :: pawrad
3208 : : type(pawtab_type),intent(inout) :: pawtab
3209 : : !arrays
3210 : : real(dp),intent(in) :: qgrid_ff(mqgrid_ff),qgrid_vl(mqgrid_vl)
3211 : : real(dp),intent(inout) :: ffspl(mqgrid_ff,2,lnmax)
3212 : : real(dp),intent(out) :: vlspl(mqgrid_vl,2)
3213 : :
3214 : : !Local variables ------------------------------
3215 : : !scalars
3216 : : integer :: has_v_minushalf,ib,icoremesh,icoretaumesh,il,ilm,ilmn,ilmn0,iln,imainmesh,imsh,iprojmesh
3217 : : integer :: ir,iread1,ishpfmesh,ivalemesh,ivlocmesh,j0lmn,jlm,pngau
3218 : : integer :: jlmn,jln,klmn,msz,nmesh,nval,pspversion,shft,sz10,usexcnhat,vlocopt
3219 : : real(dp), parameter :: rmax_vloc=10.0_dp
3220 : : real(dp) :: fourpi,my_xc_taupos,my_el_temp,occ,rc,yp1,ypn
3221 : : logical :: save_core_msz
3222 : : character(len=500) :: msg
3223 : 316 : type(pawrad_type) :: core_mesh,coretau_mesh,shpf_mesh,tproj_mesh,vale_mesh,vloc_mesh
3224 : : !arrays
3225 : 316 : integer,allocatable :: mesh_shift(:),nprj(:)
3226 : 316 : real(dp),allocatable :: kij(:),ncore(:),shpf(:,:),tncore(:),coretau(:)
3227 : 316 : real(dp),allocatable :: tcoretau(:),tnvale(:),tproj(:,:),vhnzc(:),vlocr(:)
3228 : 316 : real(dp),allocatable :: work1(:),work2(:),work3(:),work4(:)
3229 : 316 : type(pawrad_type),allocatable :: radmesh(:)
3230 : :
3231 : : !************************************************************************
3232 : :
3233 : : if (.False.) write(std_out,*) ipsp
3234 : :
3235 : : !==========================================================
3236 : : !Destroy everything in pawtab but optional flags
3237 : 316 : call pawtab_free(pawtab)
3238 : : !Destroy everything in pawrad
3239 : 316 : call pawrad_free(pawrad)
3240 : :
3241 : : !==========================================================
3242 : : !Initialize useful data
3243 : :
3244 : 316 : pawtab%usexcnhat=usexcnhat_in
3245 : 316 : fourpi=4*acos(-1.d0)
3246 : 316 : pspversion=pawpsp_header%pawver
3247 [ + - - + ]: 316 : save_core_msz=(usewvl==1 .or. icoulomb .ne. 0)
3248 : 316 : imainmesh=-1;icoremesh=-1;icoretaumesh=-1;iprojmesh=-1
3249 : 316 : ishpfmesh=-1;ivalemesh=-1;ivlocmesh=-1
3250 [ - + ]: 316 : my_xc_taupos=xc_denpos;if(present(xc_taupos)) my_xc_taupos=xc_taupos
3251 : 316 : my_el_temp=merge(el_temp,zero,present(el_temp))
3252 : :
3253 : : !==========================================================
3254 : : !Initialize partial waves quantum numbers
3255 : :
3256 : 316 : pawtab%basis_size=pawpsp_header%basis_size
3257 [ - + + - : 948 : LIBPAW_ALLOCATE(pawtab%orbitals,(pawtab%basis_size))
+ - + - -
+ - + -
+ ]
3258 [ + + ]: 1707 : do ib=1,pawtab%basis_size
3259 : 1707 : pawtab%orbitals(ib)=paw_setuploc%valence_states%state(ib)%ll
3260 : : end do
3261 : :
3262 : : !==========================================================
3263 : : !Initialize various dims and indexes
3264 : :
3265 : 316 : pawtab%lmn_size=pawpsp_header%lmn_size
3266 : 316 : pawtab%lmn2_size=pawtab%lmn_size*(pawtab%lmn_size+1)/2
3267 [ + + ]: 1707 : pawtab%l_size=2*maxval(pawtab%orbitals)+1
3268 : 316 : pawtab%ij_size=pawtab%basis_size*(pawtab%basis_size+1)/2
3269 : :
3270 : : !indlmn calculation (indices for (l,m,n) basis)
3271 [ - + ]: 316 : if (allocated(pawtab%indlmn)) then
3272 : 0 : LIBPAW_DEALLOCATE(pawtab%indlmn)
3273 : : end if
3274 [ - + + - : 948 : LIBPAW_ALLOCATE(pawtab%indlmn,(6,pawtab%lmn_size))
+ - + - -
+ - + -
+ ]
3275 [ + + + + ]: 22527 : pawtab%indlmn(:,:)=0
3276 [ + + - + : 2339 : LIBPAW_BOUND1_ALLOCATE(nprj,BOUNDS(0,maxval(pawtab%orbitals)))
+ - + - +
- - + -
+ ]
3277 [ + + ]: 1006 : ilmn=0;iln=0;nprj=0
3278 [ + + ]: 1707 : do ib=1,pawtab%basis_size
3279 : 1391 : il=pawtab%orbitals(ib)
3280 : 1391 : nprj(il)=nprj(il)+1
3281 : 1391 : iln=iln+1
3282 [ + + ]: 4564 : do ilm=1,2*il+1
3283 : 3173 : pawtab%indlmn(1,ilmn+ilm)=il
3284 : 3173 : pawtab%indlmn(2,ilmn+ilm)=ilm-(il+1)
3285 : 3173 : pawtab%indlmn(3,ilmn+ilm)=nprj(il)
3286 : 3173 : pawtab%indlmn(4,ilmn+ilm)=il*il+ilm
3287 : 3173 : pawtab%indlmn(5,ilmn+ilm)=iln
3288 : 4564 : pawtab%indlmn(6,ilmn+ilm)=1
3289 : : end do
3290 : 1707 : ilmn=ilmn+2*il+1
3291 : : end do
3292 [ - + ]: 316 : LIBPAW_DEALLOCATE(nprj)
3293 : : !Are ilmn (found here) and pawtab%lmn_size compatibles ?
3294 [ - + ]: 316 : if (ilmn/=pawtab%lmn_size) then
3295 : : write(msg, '(a,a,a,a,a)' )&
3296 : 0 : & 'Calculated lmn size differs from',ch10,&
3297 : 0 : & 'lmn_size read from pseudo !',ch10,&
3298 : 0 : & 'Action: check your pseudopotential file.'
3299 : 0 : LIBPAW_ERROR(msg)
3300 : : end if
3301 : :
3302 : : !==========================================================
3303 : : !Read and initialize radial meshes
3304 : :
3305 : 316 : nmesh=paw_setuploc%ngrid
3306 [ - + + - : 1393 : LIBPAW_DATATYPE_ALLOCATE(radmesh,(nmesh))
+ - + - -
+ - + +
+ ]
3307 [ - + + - : 948 : LIBPAW_ALLOCATE(mesh_shift,(nmesh))
+ - + - -
+ - + ]
3308 [ + + ]: 761 : do imsh=1,nmesh
3309 : 445 : radmesh(imsh)%mesh_type=-1
3310 : 445 : radmesh(imsh)%rstep=zero
3311 : 445 : radmesh(imsh)%lstep=zero
3312 : 445 : mesh_shift(imsh)=0
3313 : 1206 : select case(trim(paw_setuploc%radial_grid(imsh)%eq))
3314 : : case("r=a*exp(d*i)")
3315 : 0 : mesh_shift(imsh)=1
3316 : 0 : radmesh(imsh)%mesh_type=3
3317 : : radmesh(imsh)%mesh_size=paw_setuploc%radial_grid(imsh)%iend &
3318 : 0 : & -paw_setuploc%radial_grid(imsh)%istart+1+mesh_shift(imsh)
3319 : 0 : radmesh(imsh)%rstep=paw_setuploc%radial_grid(imsh)%aa
3320 : 0 : radmesh(imsh)%lstep=paw_setuploc%radial_grid(imsh)%dd
3321 : : case("r=a*i/(1-b*i)")
3322 : : write(msg, '(3a)' )&
3323 : 0 : & 'The grid r=a*i/(1-b*i) is not implemented in ABINIT !',ch10,&
3324 : 0 : & 'Action: check your psp file.'
3325 : 0 : LIBPAW_ERROR(msg)
3326 : : case("r=a*i/(n-i)")
3327 : : mesh_shift(imsh)=0
3328 : 2 : radmesh(imsh)%mesh_type=5
3329 : : radmesh(imsh)%mesh_size=paw_setuploc%radial_grid(imsh)%iend &
3330 : 2 : & -paw_setuploc%radial_grid(imsh)%istart+1+mesh_shift(imsh)
3331 : 2 : radmesh(imsh)%rstep=paw_setuploc%radial_grid(imsh)%aa
3332 : 2 : radmesh(imsh)%lstep=dble(paw_setuploc%radial_grid(imsh)%nn)
3333 : : case("r=a*(exp(d*i)-1)")
3334 : : mesh_shift(imsh)=0
3335 : 443 : radmesh(imsh)%mesh_type=2
3336 : : radmesh(imsh)%mesh_size=paw_setuploc%radial_grid(imsh)%iend &
3337 : 443 : & -paw_setuploc%radial_grid(imsh)%istart+1+mesh_shift(imsh)
3338 [ - + ]: 443 : if(paw_setuploc%radial_grid(imsh)%istart==1)radmesh(imsh)%mesh_size=radmesh(imsh)%mesh_size+1
3339 : 443 : radmesh(imsh)%rstep=paw_setuploc%radial_grid(imsh)%aa
3340 : 443 : radmesh(imsh)%lstep=paw_setuploc%radial_grid(imsh)%dd
3341 : : case("r=d*i")
3342 : : mesh_shift(imsh)=0
3343 : 0 : radmesh(imsh)%mesh_type=1
3344 : : radmesh(imsh)%mesh_size=paw_setuploc%radial_grid(imsh)%iend &
3345 : 0 : & -paw_setuploc%radial_grid(imsh)%istart+1+mesh_shift(imsh)
3346 [ # # ]: 0 : if(paw_setuploc%radial_grid(imsh)%istart==1)radmesh(imsh)%mesh_size=radmesh(imsh)%mesh_size+1
3347 : 0 : radmesh(imsh)%rstep=paw_setuploc%radial_grid(imsh)%dd
3348 : : case("r=(i/n+a)^5/a-a^4")
3349 : : write(msg, '(3a)' )&
3350 : 0 : & 'The grid r=(i/n+a)^5/a-a^4 is not implemented in ABINIT !',ch10,&
3351 : 0 : & 'Action: check your psp file.'
3352 [ + - - - : 890 : LIBPAW_ERROR(msg)
+ + - -
- ]
3353 : : end select
3354 : : end do
3355 : :
3356 : : !Initialize radial meshes
3357 [ + + ]: 761 : do imsh=1,nmesh
3358 : 761 : call pawrad_init(radmesh(imsh))
3359 : : end do
3360 : :
3361 : 316 : pawtab%rpaw=pawpsp_header%rpaw
3362 : :
3363 : : !==========================================================
3364 : : !Here reading shapefunction parameters
3365 : :
3366 : 316 : pawtab%shape_type=pawpsp_header%shape_type
3367 : 316 : pawtab%shape_lambda=-1;pawtab%shape_sigma=1.d99
3368 : 316 : pawtab%rshp=pawpsp_header%rshp
3369 : 316 : pawtab%shape_lambda=paw_setuploc%shape_function%lamb
3370 [ + + ]: 316 : if(trim(paw_setuploc%shape_function%gtype)=="gauss")pawtab%shape_lambda=2
3371 : 316 : pawtab%shape_sigma=paw_setuploc%shape_function%rc
3372 : : !If shapefunction type is gaussian, check exponent
3373 [ + + ]: 316 : if (pawtab%shape_type==1) then
3374 [ - + ]: 2 : if (pawtab%shape_lambda<2) then
3375 : : write(msg, '(3a)' )&
3376 : 0 : & 'For a gaussian shape function, exponent lambda must be >1 !',ch10,&
3377 : 0 : & 'Action: check your psp file.'
3378 : 0 : LIBPAW_ERROR(msg)
3379 : : end if
3380 : : end if
3381 : :
3382 : : !If shapefunction type is Bessel, deduce here its parameters from rc
3383 [ + + ]: 316 : if (pawtab%shape_type==3) then
3384 [ - + + - : 165 : LIBPAW_ALLOCATE(pawtab%shape_alpha,(2,pawtab%l_size))
+ - + - -
+ - + -
+ ]
3385 [ - + + - : 110 : LIBPAW_ALLOCATE(pawtab%shape_q,(2,pawtab%l_size))
- + - + -
+ ]
3386 [ - + ]: 55 : rc=pawtab%rshp;if (rc<1.d-8) rc=pawtab%rpaw
3387 [ + + ]: 252 : do il=1,pawtab%l_size
3388 : 252 : call atompaw_shapebes(pawtab%shape_alpha(1:2,il),pawtab%shape_q(1:2,il),il-1,rc)
3389 : : end do
3390 : : end if
3391 : :
3392 : : !==========================================================
3393 : : !Mirror pseudopotential parameters to the output and log files
3394 : :
3395 : 316 : write(msg,'(a,i2)')' Pseudopotential format is: paw',pspversion
3396 : 316 : call wrtout(ab_out,msg,'COLL')
3397 : 316 : call wrtout(std_out, msg,'COLL')
3398 : : write(msg,'(2(a,i3),a,64i4)') &
3399 : 316 : & ' basis_size (lnmax)=',pawtab%basis_size,' (lmn_size=',&
3400 : 632 : & pawtab%lmn_size,'), orbitals=',pawtab%orbitals(1:pawtab%basis_size)
3401 : 316 : call wrtout(ab_out,msg,'COLL')
3402 : 316 : call wrtout(std_out, msg,'COLL')
3403 : 316 : write(msg,'(a,f11.8)')' Spheres core radius: rc_sph=',pawtab%rpaw
3404 : 316 : call wrtout(ab_out,msg,'COLL')
3405 : 316 : call wrtout(std_out, msg,'COLL')
3406 : 316 : write(msg,'(a,i1,a)')' ',nmesh,' radial meshes are used:'
3407 : 316 : call wrtout(ab_out,msg,'COLL')
3408 : 316 : call wrtout(std_out, msg,'COLL')
3409 : :
3410 [ + + ]: 761 : do imsh=1,nmesh
3411 [ - + ]: 445 : if (radmesh(imsh)%mesh_type==1) &
3412 : : & write(msg,'(a,i1,a,i4,a,g12.5)') &
3413 : 0 : & ' - mesh ',imsh,': r(i)=step*(i-1), size=',radmesh(imsh)%mesh_size,&
3414 : 0 : & ' , step=',radmesh(imsh)%rstep
3415 [ + + ]: 445 : if (radmesh(imsh)%mesh_type==2) &
3416 : : & write(msg,'(a,i1,a,i4,2(a,g12.5))') &
3417 : 443 : & ' - mesh ',imsh,': r(i)=AA*[exp(BB*(i-1))-1], size=',radmesh(imsh)%mesh_size,&
3418 : 886 : & ' , AA=',radmesh(imsh)%rstep,' BB=',radmesh(imsh)%lstep
3419 [ - + ]: 445 : if (radmesh(imsh)%mesh_type==3) &
3420 : : & write(msg,'(a,i1,a,i4,2(a,g12.5))') &
3421 : 0 : & ' - mesh ',imsh,': r(i)=AA*exp(BB*(i-2)), size=',radmesh(imsh)%mesh_size,&
3422 : 0 : & ' , AA=',radmesh(imsh)%rstep,' BB=',radmesh(imsh)%lstep
3423 [ - + ]: 445 : if (radmesh(imsh)%mesh_type==4) &
3424 : : & write(msg,'(a,i1,a,i4,a,g12.5)') &
3425 : 0 : & ' - mesh ',imsh,': r(i)=-AA*ln(1-(i-1)/n), n=size=',radmesh(imsh)%mesh_size,&
3426 : 0 : & ' , AA=',radmesh(imsh)%rstep
3427 [ + + ]: 445 : if (radmesh(imsh)%mesh_type==5) &
3428 : : & write(msg,'(a,i1,a,i4,2(a,g12.5))') &
3429 : 2 : & ' - mesh ',imsh,': r(i)=-AA*i/(NN-i)), n=size=',radmesh(imsh)%mesh_size,&
3430 : 4 : & ' , AA=',radmesh(imsh)%rstep,' NN=',radmesh(imsh)%lstep
3431 : 445 : call wrtout(ab_out,msg,'COLL')
3432 : 761 : call wrtout(std_out, msg,'COLL')
3433 : : end do
3434 [ + + ]: 316 : if (pawtab%shape_type==-1) then
3435 : : write(msg,'(a)')&
3436 : 1 : ' Shapefunction is NUMERIC type: directly read from atomic data file'
3437 : 1 : call wrtout(ab_out,msg,'COLL')
3438 : 1 : call wrtout(std_out, msg,'COLL')
3439 : : end if
3440 [ + + ]: 316 : if (pawtab%shape_type==1) then
3441 : : write(msg,'(2a,a,f6.3,a,i3)')&
3442 : 2 : & ' Shapefunction is EXP type: shapef(r)=exp(-(r/sigma)**lambda)',ch10,&
3443 : 4 : & ' with sigma=',pawtab%shape_sigma,' and lambda=',pawtab%shape_lambda
3444 : 2 : call wrtout(ab_out,msg,'COLL')
3445 : 2 : call wrtout(std_out, msg,'COLL')
3446 : : end if
3447 [ + + ]: 316 : if (pawtab%shape_type==2) then
3448 : : write(msg,'(a)')&
3449 : 258 : ' Shapefunction is SIN type: shapef(r)=[sin(pi*r/rshp)/(pi*r/rshp)]**2'
3450 : 258 : call wrtout(ab_out,msg,'COLL')
3451 : 258 : call wrtout(std_out, msg,'COLL')
3452 : : end if
3453 [ + + ]: 316 : if (pawtab%shape_type==3) then
3454 : : write(msg,'(a)')&
3455 : 55 : & ' Shapefunction is BESSEL type: shapef(r,l)=aa(1,l)*jl(q(1,l)*r)+aa(2,l)*jl(q(2,l)*r)'
3456 : 55 : call wrtout(ab_out,msg,'COLL')
3457 : 55 : call wrtout(std_out, msg,'COLL')
3458 : : end if
3459 [ - + ]: 316 : if (pawtab%rshp<1.d-8) then
3460 : 0 : write(msg,'(a)') ' Radius for shape functions = sphere core radius'
3461 : : else
3462 : 316 : write(msg,'(a,f11.8)') ' Radius for shape functions = ',pawtab%rshp
3463 : : end if
3464 : 316 : call wrtout(ab_out,msg,'COLL')
3465 : 316 : call wrtout(std_out, msg,'COLL')
3466 : :
3467 : : !==========================================================
3468 : : !Perfom tests
3469 : :
3470 : : !Are lmax and orbitals compatibles ?
3471 [ + + - + ]: 1707 : if (lmax/=maxval(pawtab%orbitals)) then
3472 : : write(msg, '(a,a,a)' )&
3473 : 0 : & 'lmax /= MAX(orbitals) !',ch10,&
3474 : 0 : & 'Action: check your pseudopotential file.'
3475 : 0 : LIBPAW_ERROR(msg)
3476 : : end if
3477 : :
3478 : : !Only mesh_type=1,2, 3 or 5 allowed
3479 [ + + ]: 761 : do imsh=1,nmesh
3480 [ - + ]: 761 : if (radmesh(imsh)%mesh_type>5) then
3481 : : write(msg, '(a,a,a)' )&
3482 : 0 : & 'Only mesh types 1,2,3 or 5 allowed !',ch10,&
3483 : 0 : & 'Action : check your pseudopotential or input file.'
3484 : 0 : LIBPAW_ERROR(msg)
3485 : : end if
3486 : : end do
3487 : :
3488 : : !==========================================================
3489 : : !Read tabulated atomic data
3490 : :
3491 : : !---------------------------------
3492 : : !Read wave-functions (phi)
3493 : :
3494 [ + + ]: 1707 : do ib=1,pawtab%basis_size
3495 [ + + ]: 1391 : if (ib==1) then
3496 [ + - ]: 316 : do imsh=1,nmesh
3497 [ + - ]: 316 : if(trim(paw_setuploc%ae_partial_wave(1)%grid)==trim(paw_setuploc%radial_grid(imsh)%id)) then
3498 : 316 : mmax=radmesh(imsh)%mesh_size
3499 : : call pawrad_init(pawrad,mesh_size=mmax,mesh_type=radmesh(imsh)%mesh_type, &
3500 : 316 : & rstep=radmesh(imsh)%rstep,lstep=radmesh(imsh)%lstep,r_for_intg=pawtab%rpaw)
3501 : 316 : pawtab%partialwave_mesh_size=pawrad%mesh_size
3502 : 316 : pawtab%mesh_size=pawrad_ifromr(pawrad,pawtab%rpaw)+5
3503 : 316 : pawtab%mesh_size=min(pawtab%mesh_size,pawrad%mesh_size)
3504 [ + + ]: 316 : if (pawtab%mesh_size>pawrad%mesh_size-2) pawtab%mesh_size=pawrad%mesh_size
3505 : 316 : imainmesh=imsh
3506 : 316 : exit
3507 : : end if
3508 : : end do
3509 [ - + + - : 1264 : LIBPAW_ALLOCATE(pawtab%phi,(pawtab%partialwave_mesh_size,pawtab%basis_size))
- + + - +
- + - - +
- + - + ]
3510 [ - + ]: 1075 : else if (trim(paw_setuploc%ae_partial_wave(ib)%grid)/=trim(paw_setuploc%radial_grid(imainmesh)%id)) then
3511 : : write(msg, '(a,a,a)' )&
3512 : 0 : & 'All Phi and tPhi must be given on the same radial mesh !',ch10,&
3513 : 0 : & 'Action: check your pseudopotential file.'
3514 : 0 : LIBPAW_ERROR(msg)
3515 : : end if
3516 : 1391 : shft=mesh_shift(imainmesh)
3517 : : pawtab%phi(1+shft:pawtab%partialwave_mesh_size,ib)= &
3518 : : & paw_setuploc%ae_partial_wave(ib)%data(1:pawtab%partialwave_mesh_size-shft) &
3519 [ + + ]: 2335403 : & *pawrad%rad(1+shft:pawtab%partialwave_mesh_size)
3520 [ - + ]: 1707 : if (shft==1) pawtab%phi(1,ib)=zero
3521 : : end do
3522 : 316 : write(msg,'(a,i4)') ' mmax= ',mmax
3523 : 316 : call wrtout(ab_out,msg,'COLL')
3524 : 316 : call wrtout(std_out,msg,'COLL')
3525 : :
3526 : : !---------------------------------
3527 : : !Read pseudo wave-functions (tphi)
3528 : :
3529 [ - + + - : 1264 : LIBPAW_ALLOCATE(pawtab%tphi,(pawtab%partialwave_mesh_size,pawtab%basis_size))
- + + - +
- + - - +
- + - + ]
3530 [ + + ]: 1707 : do ib=1,pawtab%basis_size
3531 : :
3532 [ - + ]: 1391 : if(trim(paw_setuploc%pseudo_partial_wave(ib)%grid)/=trim(paw_setuploc%radial_grid(imainmesh)%id)) then
3533 : : write(msg, '(a,a,a)' )&
3534 : 0 : & 'All Phi and tPhi must be given on the same radial mesh !',ch10,&
3535 : 0 : & 'Action: check your pseudopotential file.'
3536 : 0 : LIBPAW_ERROR(msg)
3537 : : end if
3538 : 1391 : shft=mesh_shift(imainmesh)
3539 : : pawtab%tphi(1+shft:pawtab%partialwave_mesh_size,ib)=&
3540 : : & paw_setuploc%pseudo_partial_wave(ib)%data(1:pawtab%partialwave_mesh_size-shft) &
3541 [ + + ]: 2335403 : & *pawrad%rad(1+shft:pawtab%partialwave_mesh_size)
3542 [ - + ]: 1707 : if (shft==1) pawtab%tphi(1,ib)=zero
3543 : : end do
3544 : : write(msg,'(a,i1)') &
3545 : 316 : & ' Radial grid used for partial waves is grid ',imainmesh
3546 : 316 : call wrtout(ab_out,msg,'COLL')
3547 : 316 : call wrtout(std_out, msg,'COLL')
3548 : :
3549 : : !---------------------------------
3550 : : !Read projectors (tproj)
3551 : :
3552 [ - + ]: 316 : if (allocated(paw_setuploc%projector_fit)) then
3553 : 0 : call wvlpaw_allocate(pawtab%wvl)
3554 [ # # # # : 0 : LIBPAW_ALLOCATE(pawtab%wvl%pngau,(pawtab%basis_size))
# # # # #
# # # #
# ]
3555 [ # # ]: 0 : do ib=1,pawtab%basis_size
3556 : 0 : pawtab%wvl%pngau(ib) = paw_setuploc%projector_fit(ib)%ngauss
3557 : : end do
3558 [ # # ]: 0 : pawtab%wvl%ptotgau = sum(pawtab%wvl%pngau) * 2
3559 [ # # # # : 0 : LIBPAW_ALLOCATE(pawtab%wvl%parg,(2,pawtab%wvl%ptotgau))
# # # # #
# # # #
# ]
3560 [ # # # # : 0 : LIBPAW_ALLOCATE(pawtab%wvl%pfac,(2,pawtab%wvl%ptotgau))
# # # # #
# # # #
# ]
3561 : 0 : pngau = 1
3562 [ # # ]: 0 : do ib=1,pawtab%basis_size
3563 : : ! Complex gaussian
3564 : : pawtab%wvl%parg(:,pngau:pngau + pawtab%wvl%pngau(ib) - 1) = &
3565 [ # # # # ]: 0 : & paw_setuploc%projector_fit(ib)%expos(:,1:pawtab%wvl%pngau(ib))
3566 : : pawtab%wvl%pfac(:,pngau:pngau + pawtab%wvl%pngau(ib) - 1) = &
3567 [ # # # # ]: 0 : & paw_setuploc%projector_fit(ib)%factors(:,1:pawtab%wvl%pngau(ib))
3568 : 0 : pngau = pngau + pawtab%wvl%pngau(ib)
3569 : : ! Conjugate gaussian
3570 : : pawtab%wvl%parg(1,pngau:pngau + pawtab%wvl%pngau(ib) - 1) = &
3571 [ # # ]: 0 : & paw_setuploc%projector_fit(ib)%expos(1,1:pawtab%wvl%pngau(ib))
3572 : : pawtab%wvl%parg(2,pngau:pngau + pawtab%wvl%pngau(ib) - 1) = &
3573 [ # # ]: 0 : & -paw_setuploc%projector_fit(ib)%expos(2,1:pawtab%wvl%pngau(ib))
3574 : : pawtab%wvl%pfac(1,pngau:pngau + pawtab%wvl%pngau(ib) - 1) = &
3575 [ # # ]: 0 : & paw_setuploc%projector_fit(ib)%factors(1,1:pawtab%wvl%pngau(ib))
3576 : : pawtab%wvl%pfac(2,pngau:pngau + pawtab%wvl%pngau(ib) - 1) = &
3577 [ # # ]: 0 : & -paw_setuploc%projector_fit(ib)%factors(2,1:pawtab%wvl%pngau(ib))
3578 : 0 : pngau = pngau + pawtab%wvl%pngau(ib)
3579 : 0 : pawtab%wvl%pngau(ib) = pawtab%wvl%pngau(ib) * 2
3580 : : end do
3581 : 0 : pawtab%has_wvl=2
3582 : : else
3583 : : !Nullify wavelet objects for safety:
3584 : 316 : pawtab%has_wvl=0
3585 : 316 : call wvlpaw_free(pawtab%wvl)
3586 : : end if
3587 [ + + ]: 1707 : do ib=1,pawtab%basis_size
3588 [ + + ]: 1391 : if (ib==1) then
3589 [ + - ]: 347 : do imsh=1,nmesh
3590 [ + + ]: 347 : if(trim(paw_setuploc%projector_function(1)%grid)==trim(paw_setuploc%radial_grid(imsh)%id)) then
3591 : 316 : iprojmesh=imsh
3592 : 316 : exit
3593 : : end if
3594 : : end do
3595 : 316 : call pawrad_copy(radmesh(iprojmesh),tproj_mesh)
3596 [ - + + - : 1264 : LIBPAW_ALLOCATE(tproj,(tproj_mesh%mesh_size,pawtab%basis_size))
- + + - +
- + - - +
- + - + ]
3597 [ + - ]: 1075 : else if (trim(paw_setuploc%projector_function(ib)%grid)/=trim(paw_setuploc%radial_grid(iprojmesh)%id)) then
3598 : : write(msg, '(a,a,a)' )&
3599 : 0 : & 'All tprojectors must be given on the same radial mesh !',ch10,&
3600 : 0 : & 'Action: check your pseudopotential file.'
3601 : 0 : LIBPAW_ERROR(msg)
3602 : : end if
3603 : 1391 : shft=mesh_shift(iprojmesh)
3604 : : tproj(1+shft:tproj_mesh%mesh_size,ib)=paw_setuploc%projector_function(ib)%data(1:tproj_mesh%mesh_size-shft)&
3605 [ + + ]: 2334779 : & *tproj_mesh%rad(1+shft:tproj_mesh%mesh_size)
3606 [ - + ]: 1707 : if (shft==1) tproj(1,ib)=zero
3607 : : end do
3608 : : write(msg,'(a,i1)') &
3609 : 316 : & ' Radial grid used for projectors is grid ',iprojmesh
3610 : 316 : call wrtout(ab_out,msg,'COLL')
3611 : 316 : call wrtout(std_out, msg,'COLL')
3612 : :
3613 : : !---------------------------------
3614 : : !Read core density (coredens)
3615 : :
3616 [ + - ]: 374 : do imsh=1,nmesh
3617 [ + + ]: 374 : if(trim(paw_setuploc%ae_core_density%grid)==trim(paw_setuploc%radial_grid(imsh)%id)) then
3618 : 316 : icoremesh=imsh
3619 : 316 : exit
3620 : : end if
3621 : : end do
3622 : 316 : call pawrad_copy(radmesh(icoremesh),core_mesh)
3623 : : if ((radmesh(icoremesh)%mesh_type/=pawrad%mesh_type).or.&
3624 [ + - + - : 316 : & (radmesh(icoremesh)%rstep /=pawrad%rstep) .or.&
- + ]
3625 : : & (radmesh(icoremesh)%lstep /=pawrad%lstep)) then
3626 : : write(msg, '(a,a,a,a,a)' )&
3627 : 0 : & 'Ncore must be given on a radial mesh with the same',ch10,&
3628 : 0 : & 'type and step(s) than the main radial mesh (mesh for Phi) !',ch10,&
3629 : 0 : & 'Action: check your pseudopotential file.'
3630 : 0 : LIBPAW_ERROR(msg)
3631 : : end if
3632 [ - + + - : 948 : LIBPAW_ALLOCATE(ncore,(core_mesh%mesh_size))
+ - + - -
+ - + ]
3633 : 316 : shft=mesh_shift(icoremesh)
3634 [ + + ]: 534178 : ncore(1+shft:core_mesh%mesh_size)=paw_setuploc%ae_core_density%data(1:core_mesh%mesh_size-shft)/sqrt(fourpi)
3635 [ - + ]: 316 : if (shft==1) call pawrad_deducer0(ncore,core_mesh%mesh_size,core_mesh)
3636 : :
3637 : : !Construct and save VH[z_NC] if requested
3638 [ + - ]: 316 : if (pawtab%has_vhnzc==1) then
3639 [ - + + - : 948 : LIBPAW_ALLOCATE(pawtab%VHnZC,(pawtab%mesh_size))
+ - + - -
+ - + -
+ ]
3640 [ - + + - : 632 : LIBPAW_ALLOCATE(vhnzc,(core_mesh%mesh_size))
- + - + ]
3641 : 316 : call atompaw_vhnzc(ncore,core_mesh,vhnzc,znucl)
3642 [ + + ]: 370941 : pawtab%VHnZC(1:pawtab%mesh_size)=vhnzc(1:pawtab%mesh_size)
3643 : 316 : pawtab%has_vhnzc=2
3644 [ - + ]: 316 : LIBPAW_DEALLOCATE(vhnzc)
3645 : : end if
3646 : :
3647 : 316 : pawtab%core_mesh_size=pawtab%mesh_size
3648 [ - + ]: 316 : if(save_core_msz) pawtab%core_mesh_size=core_mesh%mesh_size
3649 [ - + + - : 948 : LIBPAW_ALLOCATE(pawtab%coredens,(pawtab%core_mesh_size))
+ - + - -
+ - + -
+ ]
3650 : 316 : pawtab%rcore=core_mesh%rad(pawtab%core_mesh_size)
3651 [ + + ]: 370941 : pawtab%coredens(1:pawtab%core_mesh_size)=ncore(1:pawtab%core_mesh_size)
3652 : :
3653 : : !---------------------------------
3654 : : !Read pseudo core density (tcoredens)
3655 : :
3656 [ + - ]: 374 : do imsh=1,nmesh
3657 [ + + ]: 374 : if(trim(paw_setuploc%pseudo_core_density%grid)==trim(paw_setuploc%radial_grid(imsh)%id)) then
3658 : 316 : iread1=imsh
3659 : 316 : exit
3660 : : end if
3661 : : end do
3662 [ - + ]: 316 : if (iread1/=icoremesh) then
3663 : : write(msg, '(a,a,a,a,a,a,a,a)' )&
3664 : 0 : & 'Pseudized core density (tNcore) must be given',ch10,&
3665 : 0 : & 'on the same radial mesh as core density (Ncore) !',ch10,&
3666 : 0 : & 'Action: check your pseudopotential file.'
3667 : 0 : LIBPAW_ERROR(msg)
3668 : : end if
3669 [ - + + - : 632 : LIBPAW_ALLOCATE(tncore,(core_mesh%mesh_size))
- + - + ]
3670 : 316 : shft=mesh_shift(icoremesh)
3671 [ + + ]: 534178 : tncore(1+shft:core_mesh%mesh_size)=paw_setuploc%pseudo_core_density%data(1:core_mesh%mesh_size-shft)/sqrt(fourpi)
3672 [ - + ]: 316 : if (shft==1) call pawrad_deducer0(tncore,core_mesh%mesh_size,core_mesh)
3673 [ - + ]: 316 : if(save_core_msz) then
3674 [ # # # # : 0 : LIBPAW_ALLOCATE(pawtab%tcoredens,(pawtab%core_mesh_size,6))
# # # # #
# # # #
# ]
3675 : : else
3676 [ - + + - : 948 : LIBPAW_ALLOCATE(pawtab%tcoredens,(pawtab%core_mesh_size,1))
+ - + - -
+ - + -
+ ]
3677 : : end if
3678 [ + - - + : 534494 : if (maxval(abs(tncore(:)))<tol6) then
- - + + +
+ ]
3679 : 55 : pawtab%usetcore=0
3680 [ + + + + ]: 65371 : pawtab%tcoredens(1:pawtab%core_mesh_size,:)=zero
3681 : : else
3682 : 261 : pawtab%usetcore=1
3683 [ + + ]: 305625 : pawtab%tcoredens(1:pawtab%core_mesh_size,1)=tncore(1:pawtab%core_mesh_size)
3684 : : end if
3685 : : write(msg,'(a,i1)') &
3686 : 316 : & ' Radial grid used for (t)core density is grid ',icoremesh
3687 : 316 : call wrtout(ab_out,msg,'COLL')
3688 : 316 : call wrtout(std_out, msg,'COLL')
3689 : :
3690 : : !---------------------------------
3691 : : !Read core kinetic density (coretau)
3692 : :
3693 [ + + + + ]: 316 : if (paw_setuploc%ae_core_kinetic_energy_density%tread.and.pawtab%has_coretau>=1) then
3694 [ + - ]: 14 : do imsh=1,nmesh
3695 [ + - ]: 14 : if(trim(paw_setuploc%ae_core_kinetic_energy_density%grid)==trim(paw_setuploc%radial_grid(imsh)%id)) then
3696 : 14 : icoretaumesh=imsh
3697 : 14 : exit
3698 : : end if
3699 : : end do
3700 : 14 : call pawrad_copy(radmesh(icoretaumesh),coretau_mesh)
3701 [ - + ]: 14 : if (icoretaumesh/=icoremesh) then
3702 : : write(msg, '(5a)' )&
3703 : 0 : & 'Core kinetic density (TAUcore) must be given',ch10,&
3704 : 0 : & 'on the same radial mesh as core density (Ncore) !',ch10,&
3705 : 0 : & 'Action: check your pseudopotential file.'
3706 : 0 : LIBPAW_ERROR(msg)
3707 : : end if
3708 [ - + + - : 42 : LIBPAW_ALLOCATE(coretau,(coretau_mesh%mesh_size))
+ - + - -
+ - + ]
3709 : 14 : shft=mesh_shift(icoretaumesh)
3710 : : coretau(1+shft:coretau_mesh%mesh_size)= &
3711 [ + + ]: 28024 : & paw_setuploc%ae_core_kinetic_energy_density%data(1:coretau_mesh%mesh_size-shft)/sqrt(fourpi)
3712 [ - + ]: 14 : if (shft==1) call pawrad_deducer0(coretau,coretau_mesh%mesh_size,coretau_mesh)
3713 : 14 : pawtab%coretau_mesh_size=pawtab%mesh_size
3714 [ - + ]: 14 : if(save_core_msz) pawtab%coretau_mesh_size=coretau_mesh%mesh_size
3715 [ - + + - : 42 : LIBPAW_ALLOCATE(pawtab%coretau,(pawtab%coretau_mesh_size))
+ - + - -
+ - + -
+ ]
3716 : 14 : pawtab%rcoretau=coretau_mesh%rad(pawtab%coretau_mesh_size)
3717 [ + + ]: 19730 : pawtab%coretau(1:pawtab%coretau_mesh_size)=coretau(1:pawtab%coretau_mesh_size)
3718 [ + - ]: 302 : else if (pawtab%has_coretau>=1) then
3719 : : write(msg, '(5a)' )&
3720 : 0 : & 'metaGGA exchange-correlation is requested but the core kinetic energy density',ch10,&
3721 : 0 : & 'is not present in the pseudopotential file!',ch10,&
3722 : 0 : & 'Action: check your pseudopotential file.'
3723 : 0 : LIBPAW_ERROR(msg)
3724 : : end if
3725 : :
3726 : : !---------------------------------
3727 : : !Read pseudo core kinetic energy density (tcoretau)
3728 : :
3729 [ + + + + ]: 316 : if (paw_setuploc%pseudo_core_kinetic_energy_density%tread.and.pawtab%has_coretau>=1) then
3730 [ + - ]: 14 : do imsh=1,nmesh
3731 [ + - ]: 14 : if(trim(paw_setuploc%pseudo_core_kinetic_energy_density%grid)==trim(paw_setuploc%radial_grid(imsh)%id)) then
3732 : 14 : iread1=imsh
3733 : 14 : exit
3734 : : end if
3735 : : end do
3736 [ - + ]: 14 : if (iread1/=icoretaumesh) then
3737 : : write(msg, '(5a)' )&
3738 : 0 : & 'Pseudized core kinetic energy density (tTAUcore) must be given',ch10,&
3739 : 0 : & 'on the same radial mesh as core kinetic density (TAUcore) !',ch10,&
3740 : 0 : & 'Action: check your pseudopotential file.'
3741 : 0 : LIBPAW_ERROR(msg)
3742 : : end if
3743 [ - + + - : 42 : LIBPAW_ALLOCATE(tcoretau,(coretau_mesh%mesh_size))
+ - + - -
+ - + -
+ ]
3744 : 14 : shft=mesh_shift(icoretaumesh)
3745 : : tcoretau(1+shft:coretau_mesh%mesh_size)= &
3746 [ + + ]: 28024 : & paw_setuploc%pseudo_core_kinetic_energy_density%data(1:coretau_mesh%mesh_size-shft)/sqrt(fourpi)
3747 [ - + ]: 14 : if (shft==1) call pawrad_deducer0(tcoretau,coretau_mesh%mesh_size,coretau_mesh)
3748 [ - + + - : 42 : LIBPAW_ALLOCATE(pawtab%tcoretau,(pawtab%coretau_mesh_size))
+ - + - -
+ - + -
+ ]
3749 [ + + ]: 19730 : pawtab%tcoretau(1:pawtab%coretau_mesh_size)=tcoretau(1:pawtab%coretau_mesh_size)
3750 : 14 : pawtab%has_coretau=2
3751 : : write(msg,'(a,i1)') &
3752 : 14 : & ' Radial grid used for (t)coretau kinetic density is grid ',icoretaumesh
3753 : 14 : call wrtout(ab_out,msg,'COLL')
3754 : 14 : call wrtout(std_out, msg,'COLL')
3755 [ - + ]: 302 : else if (pawtab%has_coretau>=1) then
3756 : : write(msg, '(5a)' )&
3757 : 0 : & 'metaGGA exchange-correlation is requested but the pseudo core kinetic energy density',ch10,&
3758 : 0 : & 'is not present in the pseudopotential file!',ch10,&
3759 : 0 : & 'Action: check your pseudopotential file.'
3760 : 0 : LIBPAW_ERROR(msg)
3761 : : end if
3762 : :
3763 : : !---------------------------------
3764 : : !Read local pseudopotential=Vh(tn_zc) or Vbare
3765 : :
3766 [ + + + + : 316 : if ((paw_setuploc%blochl_local_ionic_potential%tread).and.&
+ - + - +
+ ]
3767 : : & (pawtab%usexcnhat==-1.or.pawtab%usexcnhat==0.or.(pawtab%usexcnhat==1.and.&
3768 : : & ((.not.paw_setuploc%zero_potential%tread).or.(.not.paw_setuploc%kresse_joubert_local_ionic_potential%tread))))) then
3769 : 294 : usexcnhat=0;vlocopt=2
3770 [ + - ]: 338 : do imsh=1,nmesh
3771 [ + + ]: 338 : if(trim(paw_setuploc%blochl_local_ionic_potential%grid)==trim(paw_setuploc%radial_grid(imsh)%id)) then
3772 : 294 : iread1=imsh
3773 : 294 : exit
3774 : : end if
3775 : : end do
3776 : 294 : ivlocmesh=iread1
3777 : 294 : call pawrad_copy(radmesh(ivlocmesh),vloc_mesh)
3778 [ - + + - : 882 : LIBPAW_ALLOCATE(vlocr,(vloc_mesh%mesh_size))
+ - + - -
+ - + -
+ ]
3779 : 294 : shft=mesh_shift(ivlocmesh)
3780 [ + + ]: 521151 : vlocr(1+shft:vloc_mesh%mesh_size)=paw_setuploc%blochl_local_ionic_potential%data(1:vloc_mesh%mesh_size-shft)/sqrt(fourpi)
3781 [ - + ]: 294 : if (shft==1) call pawrad_deducer0(vlocr,vloc_mesh%mesh_size,vloc_mesh)
3782 [ + + + + : 22 : else if((paw_setuploc%kresse_joubert_local_ionic_potential%tread).and.&
+ - + - ]
3783 : : & (pawtab%usexcnhat==-1.or.pawtab%usexcnhat==1.or.(pawtab%usexcnhat==0.and.&
3784 : : & (.not.paw_setuploc%zero_potential%tread)))) then
3785 : 12 : usexcnhat=1;vlocopt=1
3786 [ + - ]: 39 : do imsh=1,nmesh
3787 [ + + ]: 39 : if(trim(paw_setuploc%kresse_joubert_local_ionic_potential%grid)==trim(paw_setuploc%radial_grid(imsh)%id)) then
3788 : 12 : iread1=imsh
3789 : 12 : exit
3790 : : end if
3791 : : end do
3792 : 12 : ivlocmesh=iread1
3793 : 12 : call pawrad_copy(radmesh(ivlocmesh),vloc_mesh)
3794 [ - + + - : 36 : LIBPAW_ALLOCATE(vlocr,(vloc_mesh%mesh_size))
+ - + - -
+ - + -
+ ]
3795 : 12 : shft=mesh_shift(ivlocmesh)
3796 : : vlocr(1+shft:vloc_mesh%mesh_size)= &
3797 [ + + ]: 9818 : & paw_setuploc%kresse_joubert_local_ionic_potential%data(1:vloc_mesh%mesh_size-shft)/sqrt(fourpi)
3798 [ - + ]: 12 : if (shft==1) call pawrad_deducer0(vlocr,vloc_mesh%mesh_size,vloc_mesh)
3799 [ + - ]: 10 : else if(paw_setuploc%zero_potential%tread) then
3800 : 10 : usexcnhat=0;vlocopt=0
3801 [ + - ]: 34 : do imsh=1,nmesh
3802 [ + + ]: 34 : if(trim(paw_setuploc%zero_potential%grid)==trim(paw_setuploc%radial_grid(imsh)%id)) then
3803 : 10 : iread1=imsh
3804 : 10 : exit
3805 : : end if
3806 : : end do
3807 : 10 : ivlocmesh=iread1
3808 : : ! vloc_mesh%mesh_type=radmesh(ivlocmesh)%mesh_type
3809 : : ! vloc_mesh%rstep=radmesh(ivlocmesh)%rstep
3810 : : ! vloc_mesh%lstep=radmesh(ivlocmesh)%lstep
3811 : : ! vloc_mesh%mesh_size=radmesh(ivlocmesh)%mesh_size
3812 : : ! vloc_mesh%mesh_size=pawrad_ifromr(radmesh(ivlocmesh),rmax_vloc)
3813 : 10 : call pawrad_copy(radmesh(ivlocmesh),vloc_mesh)
3814 [ - + + - : 30 : LIBPAW_ALLOCATE(vlocr,(vloc_mesh%mesh_size))
+ - + - -
+ - + -
+ ]
3815 [ + + ]: 5462 : vlocr=zero
3816 : 10 : shft=mesh_shift(ivlocmesh)
3817 [ + + ]: 5462 : vlocr(1+shft:vloc_mesh%mesh_size)=paw_setuploc%zero_potential%data(1:vloc_mesh%mesh_size-shft)/sqrt(fourpi)
3818 [ - + ]: 10 : if (shft==1) call pawrad_deducer0(vlocr,vloc_mesh%mesh_size,vloc_mesh)
3819 : : else
3820 : : write(msg, '(a,a,a,a,a)' )&
3821 : 0 : & 'At least one local potential must be given',ch10,&
3822 : 0 : & 'Action: check your pseudopotential file.'
3823 : 0 : LIBPAW_ERROR(msg)
3824 : : end if
3825 : :
3826 : : write(msg,'(a,i1)') &
3827 : 316 : & ' Radial grid used for Vloc is grid ',ivlocmesh
3828 : 316 : call wrtout(ab_out,msg,'COLL')
3829 : 316 : call wrtout(std_out, msg,'COLL')
3830 : :
3831 : : !-------------------------------------------------
3832 : : !Read LDA-1/2 potential
3833 : :
3834 [ + + ]: 316 : if (paw_setuploc%LDA_minus_half_potential%tread) then
3835 [ + - ]: 3 : do imsh=1,nmesh
3836 [ + - ]: 3 : if(trim(paw_setuploc%LDA_minus_half_potential%grid)==trim(paw_setuploc%radial_grid(imsh)%id)) then
3837 : 3 : iread1=imsh
3838 : 3 : exit
3839 : : end if
3840 : : end do
3841 [ - + ]: 3 : if(iread1/=ivlocmesh) then
3842 : : write(msg, '(a)' )&
3843 : 0 : & 'The LDA-1/2 potential must be given on the same grid as the local potential.'
3844 : 0 : LIBPAW_ERROR(msg)
3845 : : end if
3846 : 3 : has_v_minushalf=1
3847 [ - + + - : 9 : LIBPAW_ALLOCATE(pawtab%vminushalf,(vloc_mesh%mesh_size))
+ - + - -
+ - + -
+ ]
3848 : 3 : shft=mesh_shift(ivlocmesh)
3849 : 3 : pawtab%vminus_mesh_size=vloc_mesh%mesh_size
3850 : : pawtab%vminushalf(1+shft:vloc_mesh%mesh_size)= &
3851 [ + + ]: 6006 : & paw_setuploc%LDA_minus_half_potential%data(1:vloc_mesh%mesh_size-shft)/sqrt(fourpi)
3852 [ - + ]: 3 : if (shft==1) call pawrad_deducer0(pawtab%vminushalf,vloc_mesh%mesh_size,vloc_mesh)
3853 : : write(msg,'(a,i1)') &
3854 : 3 : & ' Radial grid used for LDA-1/2 potential is grid ',ivlocmesh
3855 : 3 : call wrtout(ab_out,msg,'COLL')
3856 : 3 : call wrtout(std_out, msg,'COLL')
3857 : : else
3858 : : has_v_minushalf=0
3859 : : end if
3860 [ - + ]: 313 : if(has_v_minushalf==0.and.pawtab%has_vminushalf==1) then
3861 : : write(msg, '(a)' )&
3862 : 0 : & 'The LDA-1/2 potential must be given in the XML PAW datafile.'
3863 : 0 : LIBPAW_ERROR(msg)
3864 : : end if
3865 : :
3866 : : !---------------------------------
3867 : : !Eventually read "numeric" shapefunctions (if shape_type=-1)
3868 : :
3869 [ + + ]: 316 : if (pawtab%shape_type==-1) then
3870 [ - + + - : 4 : LIBPAW_ALLOCATE(pawtab%shapefunc,(pawtab%mesh_size,pawtab%l_size))
- + + - +
- + - - +
- + - + ]
3871 [ + - ]: 1 : do imsh=1,nmesh
3872 [ + - ]: 1 : if(trim(paw_setuploc%shape_function%grid)==trim(paw_setuploc%radial_grid(imsh)%id)) then
3873 : 1 : iread1=imsh
3874 : 1 : exit
3875 : : end if
3876 : : end do
3877 : 1 : call pawrad_copy(radmesh(iread1),shpf_mesh)
3878 : 1 : ishpfmesh=iread1
3879 [ - + + - : 4 : LIBPAW_ALLOCATE(shpf,(shpf_mesh%mesh_size,pawtab%l_size))
- + + - +
- + - - +
- + ]
3880 : 1 : shft=mesh_shift(ishpfmesh)
3881 : 1 : shpf(1,1)=one
3882 [ + + ]: 594 : do ir=2,shpf_mesh%mesh_size
3883 : 594 : shpf(ir,1)=paw_setuploc%shape_function%data(ir-shft,1)
3884 : : end do
3885 : 1 : sz10=size(paw_setuploc%shape_function%data,2)
3886 [ + - ]: 1 : if(sz10>=2) then
3887 [ + + ]: 5 : do il=2,pawtab%l_size
3888 : 4 : shpf(1,il)=zero
3889 [ + + ]: 2377 : do ir=2,shpf_mesh%mesh_size
3890 : 2376 : shpf(ir,il)=paw_setuploc%shape_function%data(ir-shft,il)
3891 : : end do
3892 : : end do
3893 : : else
3894 [ # # ]: 0 : do il=2,pawtab%l_size
3895 : 0 : shpf(1,il)=zero
3896 [ # # ]: 0 : do ir=2,shpf_mesh%mesh_size
3897 : 0 : shpf(ir,il)=paw_setuploc%shape_function%data(ir-shft,1)*shpf_mesh%rad(ir)**(il-1)
3898 : : end do
3899 : : end do
3900 : : end if
3901 : : write(msg,'(a,i1)') &
3902 : 1 : & ' Radial grid used for shape functions is grid ',iread1
3903 : 1 : call wrtout(ab_out,msg,'COLL')
3904 : 1 : call wrtout(std_out, msg,'COLL')
3905 : :
3906 : : ! Has to spline shape functions if mesh is not the "main" mesh
3907 [ - + ]: 1 : if (ishpfmesh/=imainmesh) then
3908 : 0 : msz=shpf_mesh%mesh_size
3909 [ # # # # : 0 : LIBPAW_ALLOCATE(work1,(msz))
# # # # #
# # # ]
3910 [ # # # # : 0 : LIBPAW_ALLOCATE(work2,(msz))
# # # # ]
3911 [ # # # # : 0 : LIBPAW_ALLOCATE(work3,(msz))
# # # # ]
3912 [ # # # # : 0 : LIBPAW_ALLOCATE(work4,(pawrad%mesh_size))
# # # # #
# # # ]
3913 [ # # ]: 0 : work3(1:msz)=shpf_mesh%rad(1:msz)
3914 [ # # ]: 0 : work4(1:pawrad%mesh_size)=pawrad%rad(1:pawrad%mesh_size)
3915 [ # # ]: 0 : do il=1,pawtab%l_size
3916 : 0 : call bound_deriv(shpf(1:msz,il),shpf_mesh,msz,yp1,ypn)
3917 : 0 : call paw_spline(work3,shpf(:,il),msz,yp1,ypn,work1)
3918 : 0 : call paw_splint(msz,work3,shpf(:,il),work1,pawrad%mesh_size,work4,pawtab%shapefunc(:,il))
3919 : : end do
3920 [ # # ]: 0 : LIBPAW_DEALLOCATE(work1)
3921 [ # # ]: 0 : LIBPAW_DEALLOCATE(work2)
3922 [ # # ]: 0 : LIBPAW_DEALLOCATE(work3)
3923 [ # # ]: 0 : LIBPAW_DEALLOCATE(work4)
3924 : : else
3925 [ + + + + ]: 2976 : pawtab%shapefunc(:,:)=shpf(:,:)
3926 : : end if
3927 : 1 : LIBPAW_DEALLOCATE(shpf)
3928 : : end if
3929 : :
3930 : : !---------------------------------
3931 : : !Read pseudo valence density
3932 : :
3933 [ + + ]: 316 : if (paw_setuploc%pseudo_valence_density%tread) then
3934 [ + - ]: 442 : do imsh=1,nmesh
3935 [ + + ]: 442 : if(trim(paw_setuploc%pseudo_valence_density%grid)==trim(paw_setuploc%radial_grid(imsh)%id)) then
3936 : 315 : iread1=imsh
3937 : 315 : exit
3938 : : end if
3939 : : end do
3940 : 315 : ivalemesh=iread1
3941 : 315 : call pawrad_copy(radmesh(iread1),vale_mesh)
3942 [ - + + - : 945 : LIBPAW_ALLOCATE(tnvale,(vale_mesh%mesh_size))
+ - + - -
+ - + ]
3943 : 315 : shft=mesh_shift(ivalemesh)
3944 [ + + ]: 537717 : tnvale(1+shft:vale_mesh%mesh_size)=paw_setuploc%pseudo_valence_density%data(1:vale_mesh%mesh_size-shft)/sqrt(fourpi)
3945 [ - + ]: 315 : if (shft==1) call pawrad_deducer0(tnvale,vale_mesh%mesh_size,vale_mesh)
3946 : 315 : pawtab%has_tvale=1
3947 : : write(msg,'(a,i1)') &
3948 : 315 : & ' Radial grid used for pseudo valence density is grid ',ivalemesh
3949 : 315 : call wrtout(ab_out,msg,'COLL')
3950 : 315 : call wrtout(std_out, msg,'COLL')
3951 : : else
3952 : 1 : pawtab%has_tvale=0
3953 [ - + ]: 1 : LIBPAW_ALLOCATE(tnvale,(0))
3954 : : end if
3955 : :
3956 : : !---------------------------------
3957 : : !Read initial guess of rhoij (rhoij0)
3958 : :
3959 [ - + + - : 948 : LIBPAW_ALLOCATE(pawtab%rhoij0,(pawtab%lmn2_size))
+ - + - -
+ - + -
+ ]
3960 [ + + ]: 22581 : pawtab%rhoij0=zero
3961 : 316 : ilmn0=0
3962 [ + + ]: 1707 : do ib=1,pawtab%basis_size
3963 : 1391 : il=2*pawtab%orbitals(ib)+1
3964 : 1391 : occ=paw_setuploc%valence_states%state(ib)%ff
3965 : : if (occ<zero)occ=zero
3966 [ + + ]: 4564 : do ilmn=ilmn0+1,ilmn0+il
3967 : 4564 : pawtab%rhoij0(ilmn*(ilmn+1)/2)=occ/dble(il)
3968 : : end do
3969 : 1707 : ilmn0=ilmn0+il
3970 : : end do
3971 : :
3972 : : !---------------------------------
3973 : : !Read Kij terms (kij0) and deduce eventually Dij0
3974 : :
3975 [ - + + - : 632 : LIBPAW_ALLOCATE(kij,(pawtab%lmn2_size))
- + - + ]
3976 [ + + ]: 22581 : kij=zero
3977 : 316 : nval=paw_setuploc%valence_states%nval
3978 [ + + ]: 3489 : do jlmn=1,pawtab%lmn_size
3979 : 3173 : j0lmn=jlmn*(jlmn-1)/2
3980 : 3173 : jlm=pawtab%indlmn(4,jlmn);jln=pawtab%indlmn(5,jlmn)
3981 [ + + ]: 25754 : do ilmn=1,jlmn
3982 : 22265 : klmn=j0lmn+ilmn
3983 : 22265 : ilm=pawtab%indlmn(4,ilmn);iln=pawtab%indlmn(5,ilmn)
3984 [ + + ]: 25438 : if (ilm==jlm) kij(klmn)=paw_setuploc%kinetic_energy_differences%data(jln+(iln-1)*nval)
3985 : : end do
3986 : : end do
3987 [ + + ]: 316 : if (vlocopt>0) then
3988 [ - + + - : 612 : LIBPAW_ALLOCATE(pawtab%dij0,(pawtab%lmn2_size))
- + - + -
+ ]
3989 [ + + + + ]: 306 : if (allocated(pawtab%vminushalf).and.pawtab%has_vminushalf==1) then
3990 [ + + ]: 2002 : vlocr(1:vloc_mesh%mesh_size)=vlocr(1:vloc_mesh%mesh_size)+pawtab%vminushalf(1:vloc_mesh%mesh_size)
3991 : : end if
3992 : : call atompaw_dij0(pawtab%indlmn,kij,pawtab%lmn_size,ncore,0,pawtab,pawrad,core_mesh,&
3993 : 306 : & vloc_mesh,vlocr,znucl)
3994 : : end if
3995 : :
3996 : : !Keep eventualy Kij in memory
3997 [ + + + + ]: 316 : if (pawtab%has_kij==1.or.vlocopt==0) then
3998 [ - + + - : 141 : LIBPAW_ALLOCATE(pawtab%kij,(pawtab%lmn2_size))
+ - + - -
+ - + -
+ ]
3999 [ + + ]: 4348 : pawtab%kij(:)=kij(:)
4000 [ + + ]: 47 : if (vlocopt> 0) pawtab%has_kij=2
4001 : : ! This -1 means that pawtab%kij will be freed later
4002 [ + + ]: 47 : if (vlocopt==0) pawtab%has_kij=-1
4003 : : end if
4004 : :
4005 [ - + ]: 316 : LIBPAW_DEALLOCATE(kij)
4006 : :
4007 : : !---------------------------------
4008 : : !Read exact-exchange Fock terms for core-valence interactions (ex_cvij)
4009 : :
4010 [ + + ]: 316 : if (paw_setuploc%exact_exchange_matrix%tread.eqv..true.) then
4011 : 281 : pawtab%has_fock=2
4012 [ - + + - : 843 : LIBPAW_ALLOCATE(pawtab%ex_cvij,(pawtab%lmn2_size))
+ - + - -
+ - + -
+ ]
4013 [ + + ]: 21151 : pawtab%ex_cvij=zero
4014 : 281 : nval=paw_setuploc%valence_states%nval
4015 [ + + ]: 3164 : do jlmn=1,pawtab%lmn_size
4016 : 2883 : j0lmn=jlmn*(jlmn-1)/2
4017 : 2883 : jlm=pawtab%indlmn(4,jlmn);jln=pawtab%indlmn(5,jlmn)
4018 [ + + ]: 24034 : do ilmn=1,jlmn
4019 : 20870 : klmn=j0lmn+ilmn
4020 : 20870 : ilm=pawtab%indlmn(4,ilmn);iln=pawtab%indlmn(5,ilmn)
4021 [ + + ]: 23753 : if (ilm==jlm) pawtab%ex_cvij(klmn)=paw_setuploc%exact_exchange_matrix%data(jln+(iln-1)*nval)
4022 : : end do
4023 : : end do
4024 : 281 : pawtab%ex_cc=paw_setuploc%ex_cc
4025 : : end if
4026 : :
4027 : : !----------------------------------------
4028 : : !Store Lamb shielding
4029 : 316 : pawtab%lamb_shielding=paw_setuploc%lamb_shielding
4030 : :
4031 : : !Store kinetic core energy
4032 : 316 : pawtab%ekincore=paw_setuploc%ekin_core
4033 : :
4034 : : !==========================================================
4035 : : !Compute additional atomic data only depending on present DATASET
4036 : :
4037 : : call pawpsp_calc(core_mesh,epsatm,ffspl,imainmesh,hyb_mixing,ixc,lnmax,&
4038 : : & mmax,mqgrid_ff,mqgrid_vl,ncore,nmesh,pawrad,pawtab,pawxcdev,pspversion,&
4039 : : & qgrid_ff,qgrid_vl,radmesh,tncore,tnvale,tproj,tproj_mesh,usexcnhat,vale_mesh,&
4040 : : & vloc_mesh,vlocopt,vlocr,vlspl,xcccrc,xclevel,xc_denpos,zion,znucl,&
4041 : 316 : & tcoretau=tcoretau,coretau_mesh=coretau_mesh,xc_taupos=my_xc_taupos,el_temp=my_el_temp)
4042 : :
4043 [ + - - + ]: 316 : if(usewvl==1 .or. icoulomb > 0) then
4044 : : ! Calculate up to the 5th derivative of tcoredens
4045 : 0 : call pawpsp_calc_d5(core_mesh,pawtab%core_mesh_size,pawtab%tcoredens)
4046 : : ! Other wvl related operations
4047 : 0 : call pawpsp_wvl_calc(pawtab,tnvale,usewvl,vale_mesh,vloc_mesh,vlocr)
4048 [ - + ]: 316 : else if (pawtab%has_wvl>0) then
4049 : 0 : call wvlpaw_rholoc_nullify(pawtab%wvl%rholoc)
4050 : : end if
4051 : :
4052 : : !==========================================================
4053 : : !Free temporary allocated space
4054 : :
4055 : 316 : call pawrad_free(radmesh)
4056 [ + - + + : 761 : LIBPAW_DATATYPE_DEALLOCATE(radmesh)
- + - + -
+ - + ]
4057 : 316 : LIBPAW_DEALLOCATE(mesh_shift)
4058 : :
4059 : 316 : call pawrad_free(tproj_mesh)
4060 : 316 : call pawrad_free(core_mesh)
4061 : 316 : call pawrad_free(vloc_mesh)
4062 : 316 : call pawrad_free(coretau_mesh)
4063 : :
4064 [ + - ]: 316 : if (allocated(vlocr)) then
4065 : 316 : LIBPAW_DEALLOCATE(vlocr)
4066 : : end if
4067 [ + - ]: 316 : if (allocated(ncore)) then
4068 : 316 : LIBPAW_DEALLOCATE(ncore)
4069 : : end if
4070 [ + - ]: 316 : if (allocated(tncore)) then
4071 : 316 : LIBPAW_DEALLOCATE(tncore)
4072 : : end if
4073 [ + + ]: 316 : if (allocated(coretau)) then
4074 : 14 : LIBPAW_DEALLOCATE(coretau)
4075 : : end if
4076 [ + + ]: 316 : if (allocated(tcoretau)) then
4077 : 14 : LIBPAW_DEALLOCATE(tcoretau)
4078 : : end if
4079 [ + - ]: 316 : if (allocated(tproj)) then
4080 : 316 : LIBPAW_DEALLOCATE(tproj)
4081 : : end if
4082 : :
4083 [ + + ]: 316 : if(pawtab%shape_type==-1) then
4084 : 1 : call pawrad_free(shpf_mesh)
4085 : : end if
4086 [ + + ]: 316 : if (paw_setuploc%pseudo_valence_density%tread) then
4087 : 315 : call pawrad_free(vale_mesh)
4088 : : end if
4089 [ + + + + ]: 316 : if (paw_setuploc%ae_core_kinetic_energy_density%tread.and.pawtab%has_coretau>=1) then
4090 : 14 : call pawrad_free(coretau_mesh)
4091 : : end if
4092 [ + - ]: 316 : if (allocated(tnvale)) then
4093 : 316 : LIBPAW_DEALLOCATE(tnvale)
4094 : : end if
4095 : :
4096 [ - + - + : 632 : end subroutine pawpsp_17in
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + -
+ ]
4097 : : !!***
4098 : :
4099 : : !-------------------------------------------------------------------------
4100 : :
4101 : : !!****f* m_pawpsp/pawpsp_7in
4102 : : !! NAME
4103 : : !! pawpsp_7in
4104 : : !!
4105 : : !! FUNCTION
4106 : : !! Initialize pspcod=7 ("PAW pseudopotentials"):
4107 : : !! continue to read the corresponding file and compute the form factors
4108 : : !!
4109 : : !! INPUTS
4110 : : !! icoulomb==0 : usual reciprocal space computation
4111 : : !! =1 : free boundary conditions are used
4112 : : !! ipsp=id in the array of the currently read pseudo.
4113 : : !! ixc=exchange-correlation choice from main routine data file
4114 : : !! lloc=angular momentum choice of local pseudopotential
4115 : : !! lmax=value of lmax mentioned at the second line of the psp file
4116 : : !! pawxcdev=choice of XC development (0=no dev. (use of angular mesh) ; 1 or 2=dev. on moments)
4117 : : !! xclevel= XC functional level
4118 : : !! xc_denpos= lowest allowed density (usually for the computation of the XC functionals)
4119 : : !! [xc_taupos]= lowest allowed kinetic energy density (for mGGA XC functionals)
4120 : : !! [el_temp]=electronic temperature (hartree)
4121 : : !! zion=nominal valence of atom as specified in psp file
4122 : : !!
4123 : : !! OUTPUT
4124 : : !! epsatm=$ (4\pi)\int_0^\infty [r^2 (V(r)+\frac{Zv}{r}) dr]$(hartree)
4125 : : !! ffspl(psps%mqgrid_ff,2,psps%lnmax)=form factor f_l(q) and second derivative
4126 : : !! from spline fit for each angular momentum and each projector;
4127 : : !! pawrad <type(pawrad_type)>=paw radial mesh and related data
4128 : : !! pawtab <type(pawtab_type)>=paw tabulated starting data
4129 : : !! vlspl(mqgrid_vl,2)=q^2 Vloc(q) and second derivatives from spline fit
4130 : : !! xcccrc=XC core correction cutoff radius (bohr) from psp file
4131 : : !!
4132 : : !! NOTES
4133 : : !! Spin-orbit not yet implemented (to be done)
4134 : : !!
4135 : : !! SOURCE
4136 : :
4137 : 233 : subroutine pawpsp_7in(epsatm,ffspl,icoulomb,hyb_mixing,ixc,&
4138 : : & lmax,lnmax,mmax,mqgrid_ff,mqgrid_vl,&
4139 : 233 : & pawrad,pawtab,pawxcdev,qgrid_ff,qgrid_vl,&
4140 : 233 : & usewvl,usexcnhat_in,vlspl,xcccrc,xclevel,xc_denpos,zion,znucl,&
4141 : : & xc_taupos,el_temp) ! Optional argument
4142 : :
4143 : : !Arguments ------------------------------------
4144 : : !scalars
4145 : : integer, intent(in):: icoulomb,ixc
4146 : : integer, intent(in):: lmax,lnmax,mmax
4147 : : integer, intent(in):: mqgrid_ff,mqgrid_vl,pawxcdev
4148 : : integer, intent(in):: usewvl,usexcnhat_in,xclevel
4149 : : real(dp), intent(in):: hyb_mixing,xc_denpos,zion,znucl
4150 : : real(dp), intent(in),optional:: xc_taupos,el_temp
4151 : : real(dp), intent(out):: epsatm,xcccrc
4152 : : type(pawrad_type), intent(inout):: pawrad
4153 : : type(pawtab_type), intent(inout) :: pawtab
4154 : : !arrays
4155 : : real(dp),intent(in):: qgrid_ff(mqgrid_ff),qgrid_vl(mqgrid_vl)
4156 : : real(dp),intent(inout) :: ffspl(mqgrid_ff,2,lnmax)
4157 : : real(dp),intent(out) :: vlspl(mqgrid_vl,2)
4158 : :
4159 : : !Local variables ------------------------------
4160 : : !scalars
4161 : : integer :: imainmesh,nmesh
4162 : : integer :: pspversion,usexcnhat,vlocopt
4163 : : logical :: save_core_msz
4164 : : real(dp) :: my_xc_taupos,my_el_temp
4165 : 233 : type(pawrad_type) :: core_mesh,tproj_mesh,vale_mesh,vloc_mesh
4166 : : !arrays
4167 : 233 : real(dp),pointer :: ncore(:),tncore(:),tcoretau(:),tnvale(:),tproj(:,:),vlocr(:)
4168 : 233 : type(pawrad_type),pointer :: radmesh(:)
4169 : :
4170 : : !************************************************************************
4171 : :
4172 : : !Destroy everything in pawtab but optional flags
4173 : 233 : call pawtab_free(pawtab)
4174 : : !Destroy everything in pawrad
4175 : 233 : call pawrad_free(pawrad)
4176 : :
4177 [ + - - + ]: 233 : save_core_msz=(usewvl==1 .or. icoulomb .ne. 0)
4178 : 233 : nullify(ncore);nullify(tncore);nullify(tcoretau);nullify(tnvale)
4179 : 233 : nullify(tproj);nullify(vlocr)
4180 : 233 : nullify(radmesh)
4181 : :
4182 : : call pawpsp_read(core_mesh,tmp_unit,imainmesh,lmax,&
4183 : : & ncore,nmesh,pawrad,pawtab,pspversion,radmesh,save_core_msz,&
4184 : : & tcoretau,tncore,tnvale,tproj,tproj_mesh,usexcnhat_in,usexcnhat,&
4185 : 233 : & vale_mesh,vlocopt,vlocr,vloc_mesh,znucl)
4186 : :
4187 [ - + ]: 233 : my_xc_taupos=xc_denpos;if(present(xc_taupos)) my_xc_taupos=xc_taupos
4188 : 233 : my_el_temp=merge(el_temp,zero,present(el_temp))
4189 : : call pawpsp_calc(core_mesh,epsatm,ffspl,imainmesh,hyb_mixing,ixc,lnmax,&
4190 : : & mmax,mqgrid_ff,mqgrid_vl,ncore,nmesh,pawrad,pawtab,pawxcdev,pspversion,&
4191 : : & qgrid_ff,qgrid_vl,radmesh,tncore,tnvale,tproj,tproj_mesh,usexcnhat,vale_mesh,&
4192 : : & vloc_mesh,vlocopt,vlocr,vlspl,xcccrc,xclevel,xc_denpos,zion,znucl,&
4193 [ - + - + : 233 : & tcoretau=tcoretau,coretau_mesh=core_mesh,xc_taupos=my_xc_taupos,el_temp=my_el_temp)
- + - + -
+ - + ]
4194 : :
4195 [ + - - + ]: 233 : if(usewvl==1 .or. icoulomb > 0) then
4196 : : ! Calculate up to the 5th derivative of tcoredens
4197 : 0 : call pawpsp_calc_d5(core_mesh,pawtab%core_mesh_size,pawtab%tcoredens)
4198 : : ! Other wvl related operations
4199 [ # # # # ]: 0 : call pawpsp_wvl_calc(pawtab,tnvale,usewvl,vale_mesh,vloc_mesh,vlocr)
4200 [ - + ]: 233 : else if (pawtab%has_wvl>0) then
4201 : 0 : call wvlpaw_rholoc_nullify(pawtab%wvl%rholoc)
4202 : : end if
4203 : :
4204 : : !==========================================================
4205 : : !Free temporary allocated space
4206 : 233 : call pawrad_free(radmesh)
4207 : 233 : call pawrad_free(tproj_mesh)
4208 : 233 : call pawrad_free(core_mesh)
4209 : 233 : call pawrad_free(vloc_mesh)
4210 [ - + ]: 233 : LIBPAW_DATATYPE_DEALLOCATE(radmesh)
4211 [ + - ]: 233 : if (associated(vlocr)) then
4212 : 233 : LIBPAW_POINTER_DEALLOCATE(vlocr)
4213 : : end if
4214 [ + - ]: 233 : if (associated(ncore)) then
4215 : 233 : LIBPAW_POINTER_DEALLOCATE(ncore)
4216 : : end if
4217 [ + - ]: 233 : if (associated(tncore)) then
4218 : 233 : LIBPAW_POINTER_DEALLOCATE(tncore)
4219 : : end if
4220 [ + - ]: 233 : if (associated(tnvale)) then
4221 : 233 : LIBPAW_POINTER_DEALLOCATE(tnvale)
4222 : : end if
4223 [ - + ]: 233 : if (associated(tcoretau)) then
4224 : 0 : LIBPAW_POINTER_DEALLOCATE(tcoretau)
4225 : : end if
4226 [ + - ]: 233 : if (associated(tproj)) then
4227 : 233 : LIBPAW_POINTER_DEALLOCATE(tproj)
4228 : : end if
4229 [ + + ]: 233 : if (pspversion>=4) then
4230 : 90 : call pawrad_free(vale_mesh)
4231 : : end if
4232 : :
4233 [ - + - + : 466 : end subroutine pawpsp_7in
- + - + -
+ - + - +
- + - + -
+ - + -
+ ]
4234 : : !!***
4235 : :
4236 : : !-------------------------------------------------------------------------
4237 : :
4238 : : !!****f* m_pawpsp/pawpsp_wvl_sin2gauss
4239 : : !! NAME
4240 : : !! pawpsp_wvl_sin2gauss
4241 : : !!
4242 : : !! FUNCTION
4243 : : !! Converts a f(x)=sum_i^N_i a_i sin(b_i x)+ c_i cos( d_i x) to
4244 : : !! f(x)=sum_j e_j exp(f_j x), where e and f are complex numbers.
4245 : : !!
4246 : : !! INPUTS
4247 : : !! basis_size = size of the lmn basis
4248 : : !! mparam = number of terms in the summatory (N_i, see the expression above)
4249 : : !! nparam = Array containing the parameters (a_i, b_i,c_i,d_i)
4250 : : !! wvl = wavelets data type
4251 : : !!
4252 : : !! OUTPUT
4253 : : !!
4254 : : !! SIDE EFFECTS
4255 : : !! On output wvl%pfac and wvl%parg are filled with complex parameters (e_i, f_i)
4256 : : !!
4257 : : !! NOTES
4258 : : !!
4259 : : !! SOURCE
4260 : :
4261 : 0 : subroutine pawpsp_wvl_sin2gauss(basis_size,mparam,nparam,&
4262 : 0 : & param,wvl)
4263 : :
4264 : : !Arguments ------------------------------------
4265 : : integer,intent(in) :: mparam,basis_size
4266 : : integer,intent(in) :: nparam(basis_size)
4267 : : real(dp),intent(in) :: param(mparam,basis_size)
4268 : : type(wvlpaw_type),intent(inout):: wvl
4269 : :
4270 : : !Local variables ------------------------------
4271 : : integer :: i,ii,ib,ngauss,nterm
4272 : : real(dp) :: sep
4273 : 0 : real(dp) :: a1(mparam),a2(mparam),a3(mparam),a4(mparam),a5(mparam)
4274 : 0 : real(dp) :: b1r(mparam),b2r(mparam),b1i(mparam),b2i(mparam)
4275 : : character(len=500) :: message
4276 : : !
4277 : : !extra variables, use to debug
4278 : : !
4279 : : !integer::igau,nr,unitp
4280 : : !real(dp)::step,rmax
4281 : : !real(dp),allocatable::r(:), y(:)
4282 : : !complex::fac,arg
4283 : : !complex(dp),allocatable::f(:)
4284 : : !************************************************************************
4285 : :
4286 : : ! Convert from \sum(sin+cos) expressions to sums of complex gaussians
4287 : : ! (only works for option=4, see fit_gen)
4288 : :
4289 : : ! get number of coefficients:
4290 : 0 : ii=0
4291 [ # # ]: 0 : do ib=1,basis_size
4292 : 0 : nterm=nparam(ib)/4 !option=4, there are 4 parameters for each term
4293 : 0 : ii=ii+nterm*2 !two gaussians for each term
4294 : : end do
4295 : : !
4296 : : ! Allocate objects
4297 : : !
4298 : 0 : ngauss=ii
4299 : 0 : wvl%ptotgau=ngauss !total number of complex gaussians
4300 [ # # # # : 0 : LIBPAW_ALLOCATE(wvl%pfac,(2,ngauss))
# # # # #
# # # #
# ]
4301 [ # # # # : 0 : LIBPAW_ALLOCATE(wvl%parg,(2,ngauss))
# # # # #
# ]
4302 [ # # # # : 0 : LIBPAW_ALLOCATE(wvl%pngau,(basis_size))
# # # # #
# # # #
# ]
4303 [ # # ]: 0 : wvl%pngau(1:basis_size)=nparam(1:basis_size)/2 !option=4
4304 : : !
4305 : : ii=0
4306 [ # # ]: 0 : do ib=1,basis_size
4307 : : !
4308 : : ! Get parameters in sin+cos expansion:
4309 : : ! Option4: \sum a1 exp(-a2 x^2) ( a3 sin(k x^2) + a4 cos(k x^2))
4310 : : !
4311 : 0 : nterm=nparam(ib)/4 !option=4
4312 : : !
4313 [ # # ]: 0 : a1(1:nterm)=param(1:nterm,ib)
4314 [ # # ]: 0 : a2(1:nterm)=param(nterm+1:nterm*2,ib)
4315 [ # # ]: 0 : a3(1:nterm)=param(nterm*2+1:nterm*3,ib)
4316 [ # # ]: 0 : a4(1:nterm)=param(nterm*3+1:nterm*4,ib)
4317 : : sep=1.1d0
4318 [ # # ]: 0 : do i=1,nterm
4319 : 0 : a5(i)=sep**(i)
4320 : : end do
4321 : :
4322 : : ! First check that "a2" is a positive number (it is multiplied by -1, so
4323 : : ! that gaussians decay to zero:
4324 [ # # # # : 0 : if( any(a2(1:nterm) < tol12) ) then
# # ]
4325 : 0 : message = 'Real part of Gaussians should be a negative number (they should go to zero at infty)'
4326 : 0 : LIBPAW_ERROR(message)
4327 : : end if
4328 : :
4329 : : !
4330 : : ! Now translate them to a sum of complex gaussians:
4331 : : ! pngau(ib)=nterm*2
4332 : : ! Two gaussians by term:
4333 : : !
4334 : : ! First gaussian
4335 [ # # ]: 0 : b1r(1:nterm)= a1(1:nterm)*a4(1:nterm)/2.d0 !coefficient, real
4336 [ # # ]: 0 : b1i(1:nterm)=-a1(1:nterm)*a3(1:nterm)/2.d0 !coefficient, imag
4337 [ # # ]: 0 : b2r(1:nterm)=-a2(1:nterm) !exponential, real
4338 [ # # ]: 0 : b2i(1:nterm)= a5(1:nterm) !exponential, imag
4339 : : !
4340 [ # # ]: 0 : wvl%pfac(1,ii+1:ii+nterm)=b1r(1:nterm)
4341 [ # # ]: 0 : wvl%pfac(2,ii+1:ii+nterm)=b1i(1:nterm)
4342 [ # # ]: 0 : wvl%parg(1,ii+1:ii+nterm)=b2r(1:nterm)
4343 [ # # ]: 0 : wvl%parg(2,ii+1:ii+nterm)=b2i(1:nterm)
4344 : : ! Second gaussian
4345 [ # # ]: 0 : wvl%pfac(1,ii+nterm+1:ii+nterm*2)= b1r(1:nterm)
4346 [ # # ]: 0 : wvl%pfac(2,ii+nterm+1:ii+nterm*2)=-b1i(1:nterm)
4347 [ # # ]: 0 : wvl%parg(1,ii+nterm+1:ii+nterm*2)= b2r(1:nterm)
4348 [ # # ]: 0 : wvl%parg(2,ii+nterm+1:ii+nterm*2)=-b2i(1:nterm)
4349 : : !
4350 : 0 : ii=ii+nterm*2
4351 : : end do
4352 : :
4353 : : ! begin debug
4354 : : ! write(*,*)'pawpsp_wvl_sin2gauss, comment me'
4355 : : ! nr=3000
4356 : : ! rmax=10.d0
4357 : : ! LIBPAW_ALLOCATE(r,(nr))
4358 : : ! LIBPAW_ALLOCATE(f,(nr))
4359 : : ! LIBPAW_ALLOCATE(y,(nr))
4360 : : ! step=rmax/real(nr-1,dp)
4361 : : ! do ir=1,nr
4362 : : ! r(ir)=real(ir-1,dp)*step
4363 : : ! end do
4364 : : ! !
4365 : : ! ii=0
4366 : : ! do ib=1,basis_size
4367 : : ! unitp=500+ib
4368 : : ! f(:)=czero
4369 : : ! !
4370 : : ! do igau=1,wvl%pngau(ib)
4371 : : ! ii=ii+1
4372 : : ! arg=cmplx(wvl%parg(1,ii),wvl%parg(2,ii))
4373 : : ! fac=cmplx(wvl%pfac(1,ii),wvl%pfac(2,ii))
4374 : : ! f(:)=f(:)+fac*exp(arg*r(:)**2)
4375 : : ! end do
4376 : : ! do ir=1,nr
4377 : : ! write(unitp,'(3f16.7)')r(ir),real(f(ir))!,y(ir)
4378 : : ! end do
4379 : : ! end do
4380 : : ! LIBPAW_DEALLOCATE(r)
4381 : : ! LIBPAW_DEALLOCATE(f)
4382 : : ! LIBPAW_DEALLOCATE(y)
4383 : : ! end debug
4384 : :
4385 : 0 : end subroutine pawpsp_wvl_sin2gauss
4386 : : !!***
4387 : :
4388 : : !-------------------------------------------------------------------------
4389 : :
4390 : : !!****f* m_pawpsp/pawpsp_read_header
4391 : : !! NAME
4392 : : !! pawpsp_read_header
4393 : : !!
4394 : : !! FUNCTION
4395 : : !!
4396 : : !! INPUTS
4397 : : !!
4398 : : !! OUTPUT
4399 : : !!
4400 : : !!
4401 : : !! SIDE EFFECTS
4402 : : !!
4403 : : !! NOTES
4404 : : !!
4405 : : !! SOURCE
4406 : :
4407 : :
4408 : 0 : subroutine pawpsp_read_header(funit,lloc,lmax,mmax,pspcod,pspxc,r2well,zion,znucl)
4409 : :
4410 : : !Arguments ------------------------------------
4411 : : !scalars
4412 : : integer,intent(in):: funit
4413 : : integer,intent(out):: lloc,lmax,mmax,pspcod,pspxc
4414 : : real(dp),intent(out):: r2well,zion,znucl
4415 : : !Local variables-------------------------------
4416 : : integer:: pspdat
4417 : : character(len=fnlen):: title
4418 : : character(len=500) :: msg
4419 : :
4420 : : ! *************************************************************************
4421 : :
4422 : : !Read and write some description of file from first line (character data)
4423 : 0 : read (funit,'(a)') title
4424 : 0 : write(msg, '(a,a)' ) '- ',trim(title)
4425 : 0 : call wrtout(ab_out,msg,'COLL')
4426 : 0 : call wrtout(std_out, msg,'COLL')
4427 : :
4428 : : !Read and write more data describing psp parameters
4429 : 0 : read (funit,*) znucl,zion,pspdat
4430 : : write(msg, '(a,f9.5,f10.5,2x,i8,t47,a)' ) &
4431 : 0 : & '-',znucl,zion,pspdat,'znucl, zion, pspdat'
4432 : 0 : call wrtout(ab_out,msg,'COLL')
4433 : 0 : call wrtout(std_out, msg,'COLL')
4434 : :
4435 : 0 : read (funit,*) pspcod,pspxc,lmax,lloc,mmax,r2well
4436 [ # # ]: 0 : if(pspxc<0) then
4437 : : write(msg, '(i5,i8,2i5,i10,f10.5,t47,a)' ) &
4438 : 0 : & pspcod,pspxc,lmax,lloc,mmax,r2well,&
4439 : 0 : & 'pspcod,pspxc,lmax,lloc,mmax,r2well'
4440 : : else
4441 : : write(msg, '(4i5,i10,f10.5,t47,a)' ) &
4442 : 0 : & pspcod,pspxc,lmax,lloc,mmax,r2well,&
4443 : 0 : & 'pspcod,pspxc,lmax,lloc,mmax,r2well'
4444 : : end if
4445 : 0 : call wrtout(ab_out,msg,'COLL')
4446 : 0 : call wrtout(std_out, msg,'COLL')
4447 : :
4448 : 0 : end subroutine pawpsp_read_header
4449 : : !!***
4450 : :
4451 : : !-------------------------------------------------------------------------
4452 : :
4453 : : !!****f* m_pawpsp/pawpsp_read_header_2
4454 : : !! NAME
4455 : : !! pawpsp_read_header_2
4456 : : !!
4457 : : !! FUNCTION
4458 : : !!
4459 : : !! INPUTS
4460 : : !!
4461 : : !! OUTPUT
4462 : : !!
4463 : : !!
4464 : : !! SIDE EFFECTS
4465 : : !!
4466 : : !! NOTES
4467 : : !! Reads pspversion, basis_size and lmn_size
4468 : : !!
4469 : : !! SOURCE
4470 : :
4471 : :
4472 : 233 : subroutine pawpsp_read_header_2(funit,pspversion,basis_size,lmn_size)
4473 : :
4474 : : !Arguments ------------------------------------
4475 : : !scalars
4476 : : integer,intent(in):: funit
4477 : : integer,intent(out) :: pspversion,basis_size,lmn_size
4478 : :
4479 : : !Local variables-------------------------------
4480 : : integer :: creatorid
4481 : : character(len=80) :: pspline
4482 : : character(len=500) :: msg
4483 : :
4484 : : ! *************************************************************************
4485 : :
4486 : : !Read psp version in line 4 of the header
4487 : 233 : pspversion=1
4488 : 233 : read (funit,'(a80)') pspline;pspline=adjustl(pspline)
4489 [ - + - - ]: 233 : if (pspline(1:3)=="paw".or.pspline(1:3)=="PAW") &
4490 : 233 : & read(unit=pspline(4:80),fmt=*) pspversion
4491 [ - + ]: 233 : if (pspversion<1.or.pspversion>5) then
4492 : : write(msg, '(a,i2,a,a,a)' )&
4493 : 0 : & 'This version of PAW psp file (',pspversion,') is not compatible with',ch10,&
4494 : 0 : & 'current version of Abinit.'
4495 : 0 : LIBPAW_ERROR(msg)
4496 : : end if
4497 : :
4498 [ - + ]: 233 : if (pspversion==1) then
4499 : 0 : read (unit=pspline,fmt=*) basis_size,lmn_size
4500 : : else
4501 : : ! Here psp file for Abinit 4.3+
4502 : 233 : read (unit=pspline(5:80),fmt=*) creatorid
4503 : 233 : read (funit,*) basis_size,lmn_size
4504 : : end if
4505 : :
4506 : 233 : end subroutine pawpsp_read_header_2
4507 : : !!***
4508 : :
4509 : : !-------------------------------------------------------------------------
4510 : :
4511 : : !!****f* m_pawpsp/pawpsp_wvl
4512 : : !! NAME
4513 : : !! pawpsp_wvl
4514 : : !!
4515 : : !! FUNCTION
4516 : : !! WVL+PAW related operations
4517 : : !!
4518 : : !! INPUTS
4519 : : !!
4520 : : !! OUTPUT
4521 : : !!
4522 : : !! SIDE EFFECTS
4523 : : !!
4524 : : !! NOTES
4525 : : !!
4526 : : !! SOURCE
4527 : :
4528 : :
4529 : 0 : subroutine pawpsp_wvl(filpsp,pawrad, pawtab,usewvl, wvl_ngauss, comm_mpi)
4530 : :
4531 : : !Arguments------------------------------------
4532 : : !scalars
4533 : : integer, optional,intent(in):: comm_mpi
4534 : : integer, intent(in):: usewvl, wvl_ngauss(2)
4535 : : character(len=fnlen),intent(in)::filpsp
4536 : : type(pawrad_type),intent(in) :: pawrad
4537 : : type(pawtab_type),intent(inout):: pawtab
4538 : : !arrays
4539 : :
4540 : : !Local variables-------------------------------
4541 : : !scalars
4542 : : integer:: ii, me, mparam, nterm_bounds(2)
4543 : 0 : type(pawrad_type)::tproj_mesh
4544 : : character(len=500) :: msg
4545 : : !arrays
4546 : 0 : integer,allocatable:: ngauss_param(:)
4547 : 0 : real(dp),allocatable:: gauss_param(:,:)
4548 : :
4549 : : ! *************************************************************************
4550 : :
4551 [ # # ]: 0 : me=0; if (present(comm_mpi))me=xmpi_comm_rank(comm_mpi)
4552 : :
4553 : : !If usewvl flag is on, we must have the pawtab%wvl pointer allocated
4554 [ # # # # ]: 0 : if (usewvl==1.and.pawtab%has_wvl==0) then
4555 : 0 : call wvlpaw_allocate(pawtab%wvl)
4556 : 0 : pawtab%has_wvl=1
4557 : : end if
4558 : :
4559 : : !Fit projectors to a sum of Gaussians:
4560 [ # # # # ]: 0 : if (usewvl ==1 .and. pawtab%wvl%ptotgau==0 ) then
4561 : :
4562 [ # # ]: 0 : if (pawtab%has_tproj==0) then
4563 : 0 : msg='pawtab%tproj must be allocated'
4564 : 0 : LIBPAW_BUG(msg)
4565 : : end if
4566 : :
4567 : : ! 1) fit projectors to gaussians
4568 : 0 : write(msg,'(a,a)')ch10,'Fitting tproj to Gaussians'
4569 : 0 : call wrtout(std_out,msg,'COLL')
4570 : :
4571 : : ! See fit_gen (option==4):
4572 [ # # ]: 0 : do ii=1,2
4573 [ # # ]: 0 : nterm_bounds(ii)=ceiling(wvl_ngauss(ii)/2.0)
4574 : : end do
4575 : 0 : mparam=nterm_bounds(2)*4
4576 [ # # # # : 0 : LIBPAW_ALLOCATE(gauss_param,(mparam,pawtab%basis_size))
# # # # #
# # # # #
# # ]
4577 [ # # # # : 0 : LIBPAW_ALLOCATE(ngauss_param,(pawtab%basis_size))
# # # # #
# # # ]
4578 : : ! compute tproj_mesh
4579 : : call pawrad_init(tproj_mesh,mesh_size=size(pawtab%tproj,1),&
4580 : 0 : & mesh_type=pawrad%mesh_type,rstep=pawrad%rstep, lstep=pawrad%lstep)
4581 : :
4582 [ # # ]: 0 : if(present(comm_mpi)) then
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,comm_mpi)
4587 : : else
4588 : : call gaussfit_projector(pawtab%basis_size,mparam,&
4589 : : & ngauss_param,nterm_bounds,pawtab%orbitals,&
4590 : : & gauss_param,tproj_mesh,&
4591 : 0 : & pawtab%rpaw,pawtab%tproj)
4592 : : end if
4593 : : ! tproj is now as a sum of sin+cos functions,
4594 : : ! convert it to a sum of complex gaussians and fill %wvl object:
4595 : : call pawpsp_wvl_sin2gauss(pawtab%basis_size,mparam,&
4596 : 0 : & ngauss_param,gauss_param,pawtab%wvl)
4597 [ # # ]: 0 : LIBPAW_DEALLOCATE(gauss_param)
4598 [ # # ]: 0 : LIBPAW_DEALLOCATE(ngauss_param)
4599 : :
4600 [ # # ]: 0 : if(me==0) then
4601 : 0 : call pawpsp_rw_atompaw(pawtab%basis_size,filpsp,pawtab%wvl)
4602 : : end if
4603 : :
4604 : 0 : pawtab%has_wvl=2
4605 : :
4606 : : end if
4607 : :
4608 : : !Projectors in real space are no more needed
4609 : 0 : call pawrad_free(tproj_mesh)
4610 [ # # ]: 0 : if(allocated(pawtab%tproj)) then
4611 : 0 : LIBPAW_DEALLOCATE(pawtab%tproj)
4612 : 0 : pawtab%has_tproj=0
4613 : : end if
4614 : :
4615 [ # # # # : 0 : end subroutine pawpsp_wvl
# # ]
4616 : : !!***
4617 : :
4618 : : !-------------------------------------------------------------------------
4619 : :
4620 : : !!****f* m_pawpsp/pawpsp_read_header_xml
4621 : : !! NAME
4622 : : !! pawpsp_read_header_xml
4623 : : !!
4624 : : !! FUNCTION
4625 : : !!
4626 : : !! INPUTS
4627 : : !!
4628 : : !! OUTPUT
4629 : : !!
4630 : : !! SIDE EFFECTS
4631 : : !!
4632 : : !! NOTES
4633 : : !! This is done instead of: call pawpsxml2ab( psxml, pspheads,1)
4634 : : !! since pspheads does not exist in PAW library.
4635 : : !! should we include it to avoid the following code replica?
4636 : : !! check pspheads commented out in pawpsp_17in, and routine pawpsp_read_xml_2
4637 : : !!
4638 : : !! SOURCE
4639 : :
4640 : 511 : subroutine pawpsp_read_header_xml(lloc,lmax,pspcod,pspxc,&
4641 : : & psxml,r2well,zion,znucl)
4642 : :
4643 : : !Arguments ------------------------------------
4644 : : !scalars
4645 : : type(paw_setup_t),intent(in) :: psxml
4646 : : integer,intent(out):: lloc,lmax,pspcod,pspxc
4647 : : real(dp),intent(out):: r2well,zion,znucl
4648 : : !Local variables-------------------------------
4649 : : integer :: il
4650 : : #if defined LIBPAW_HAVE_LIBXC
4651 : : integer :: ii,id
4652 : : #endif
4653 : : character(len=100) :: xclibxc
4654 : : character(len=500) :: msg
4655 : : !arrays
4656 : :
4657 : : ! *************************************************************************
4658 : :
4659 : 511 : lloc = 0
4660 : 511 : r2well = 0
4661 : 511 : pspcod=17
4662 : 511 : znucl=psxml%atom%znucl
4663 : 511 : zion =psxml%atom%zval
4664 : :
4665 : : !lmax:
4666 : 511 : lmax = 0
4667 [ + + ]: 2786 : do il=1,psxml%valence_states%nval
4668 [ + + ]: 2786 : if(psxml%valence_states%state(il)%ll>lmax) lmax=psxml%valence_states%state(il)%ll
4669 : : end do
4670 : : !pspxc
4671 : 511 : select case(trim(psxml%xc_functional%name))
4672 : : case('PZ')
4673 : 0 : pspxc = 2
4674 : : #if defined LIBPAW_HAVE_LIBXC
4675 : : pspxc = -(libxc_functionals_getid('XC_LDA_X')*1000 &
4676 : 0 : & +libxc_functionals_getid('XC_LDA_C_PZ'))
4677 : : #endif
4678 : : case('W')
4679 : 0 : pspxc = 4
4680 : : #if defined LIBPAW_HAVE_LIBXC
4681 : : pspxc = -(libxc_functionals_getid('XC_LDA_X')*1000 &
4682 : 0 : & +libxc_functionals_getid('XC_LDA_C_WIGNER'))
4683 : : #endif
4684 : : case('HL')
4685 : 0 : pspxc = 5
4686 : : #if defined LIBPAW_HAVE_LIBXC
4687 : : pspxc = -(libxc_functionals_getid('XC_LDA_X')*1000 &
4688 : 0 : & +libxc_functionals_getid('XC_LDA_C_HL'))
4689 : : #endif
4690 : : case('GL')
4691 : : #if defined LIBPAW_HAVE_LIBXC
4692 : : pspxc = -(libxc_functionals_getid('XC_LDA_X')*1000 &
4693 : 0 : & +libxc_functionals_getid('XC_LDA_C_GL'))
4694 : : #else
4695 : : write(msg, '(7a)' )&
4696 : : & 'The exchange and correlation functional by Gunnarson-Lundqvist', ch10,&
4697 : : & 'is not implemented in Abinit.',ch10,&
4698 : : & 'Action : choose another XC functional in the pseudopotential',ch10, &
4699 : : & ' generation or compile ABINIT with the libXC library.'
4700 : : LIBPAW_ERROR(msg)
4701 : : #endif
4702 : : case('VWN')
4703 : : #if defined LIBPAW_HAVE_LIBXC
4704 : : pspxc = -(libxc_functionals_getid('XC_LDA_X')*1000 &
4705 : 0 : & +libxc_functionals_getid('XC_LDA_C_VWN'))
4706 : : #else
4707 : : write(msg, '(7a)' )&
4708 : : & 'The exchange and correlation functional by Vosko,Wilk and Nusair', ch10,&
4709 : : & 'is not implemented in Abinit.',ch10,&
4710 : : & 'Action : choose another XC functional in the pseudopotential',ch10, &
4711 : : & ' generation or compile ABINIT with the libXC library.'
4712 : : LIBPAW_ERROR(msg)
4713 : : #endif
4714 : : case('PW')
4715 : 136 : pspxc = 7
4716 : : #if defined LIBPAW_HAVE_LIBXC
4717 : : pspxc = -(libxc_functionals_getid('XC_LDA_X')*1000 &
4718 : 136 : & +libxc_functionals_getid('XC_LDA_C_PW'))
4719 : : #endif
4720 : : case('PBE')
4721 : 375 : pspxc = 11
4722 : : #if defined LIBPAW_HAVE_LIBXC
4723 : : pspxc = -(libxc_functionals_getid('XC_GGA_X_PBE')*1000 &
4724 : 375 : & +libxc_functionals_getid('XC_GGA_C_PBE'))
4725 : : #endif
4726 : : case('revPBE')
4727 : 0 : pspxc = 14
4728 : : #if defined LIBPAW_HAVE_LIBXC
4729 : : pspxc = -(libxc_functionals_getid('XC_GGA_X_PBE_R')*1000 &
4730 : 0 : & +libxc_functionals_getid('XC_GGA_C_PBE'))
4731 : : #endif
4732 : : case('RPBE')
4733 : 0 : pspxc = 15
4734 : : #if defined LIBPAW_HAVE_LIBXC
4735 : : pspxc = -(libxc_functionals_getid('XC_GGA_X_RPBE')*1000 &
4736 : 0 : & +libxc_functionals_getid('XC_GGA_C_PBE'))
4737 : : #endif
4738 : : case('PW91')
4739 : : #if defined LIBPAW_HAVE_LIBXC
4740 : : pspxc = -(libxc_functionals_getid('XC_GGA_X_PW91')*1000 &
4741 : 0 : & +libxc_functionals_getid('XC_GGA_C_PW91'))
4742 : : #else
4743 : : write(msg, '(7a)' )&
4744 : : & 'The exchange and correlation functional by Perdew and Wang 91', ch10,&
4745 : : & 'is not implemented in Abinit.',ch10,&
4746 : : & 'Action : choose another XC functional in the pseudopotential',ch10, &
4747 : : & ' generation or compile ABINIT with the libXC library.'
4748 : : LIBPAW_ERROR(msg)
4749 : : #endif
4750 : : case('BLYP')
4751 : : #if defined LIBPAW_HAVE_LIBXC
4752 : : pspxc = -(libxc_functionals_getid('XC_GGA_X_B88')*1000 &
4753 : 0 : & +libxc_functionals_getid('XC_GGA_C_LYP'))
4754 : : #else
4755 : : write(msg, '(7a)' )&
4756 : : & 'The exchange and correlation functional BLYP', ch10,&
4757 : : & 'is not implemented in Abinit.',ch10,&
4758 : : & 'Action : choose another XC functional in the pseudopotential',ch10, &
4759 : : & ' generation or compile ABINIT with the libXC library.'
4760 : : LIBPAW_ERROR(msg)
4761 : : #endif
4762 : : case DEFAULT
4763 : 0 : xclibxc=trim(psxml%xc_functional%name)
4764 : : if (xclibxc(1:3)=='XC_' .or.xclibxc(1:3)=='xc_' .or. &
4765 : : & xclibxc(1:5)=='LDA_X'.or.xclibxc(1:5)=='LDA_C'.or. &
4766 : : & xclibxc(1:5)=='lda_x'.or.xclibxc(1:5)=='lda_c'.or. &
4767 : : & xclibxc(1:5)=='GGA_X'.or.xclibxc(1:5)=='GGA_C'.or. &
4768 : : & xclibxc(1:5)=='gga_x'.or.xclibxc(1:5)=='gga_c'.or. &
4769 : : & xclibxc(1:6)=='MGGA_X'.or.xclibxc(1:6)=='MGGA_C'.or. &
4770 [ - - - - : 511 : & xclibxc(1:6)=='mgga_x'.or.xclibxc(1:6)=='mgga_c') then
- + + - -
- - - - -
- - - - -
- - - - -
- - - - -
- - - - -
- - - - -
- ]
4771 : : #if defined LIBPAW_HAVE_LIBXC
4772 : 0 : pspxc=0
4773 [ # # ]: 0 : ii=index(xclibxc,'+') ; if (ii<=0) ii=0
4774 : : if (ii>0) then
4775 : 0 : id=libxc_functionals_getid(xclibxc(1:ii-1))
4776 [ # # ]: 0 : if (id<=0) then
4777 : 0 : write(msg, '(3a)' ) 'The ',xclibxc(1:ii-1), &
4778 : 0 : & ' functional (read from PAW-XML file) was not found in the libXC library!'
4779 : 0 : LIBPAW_ERROR(msg)
4780 : : end if
4781 : 0 : pspxc=pspxc-id*1000
4782 : : end if
4783 : 0 : id=libxc_functionals_getid(xclibxc(ii+1:))
4784 [ # # ]: 0 : if (id<=0) then
4785 : 0 : write(msg, '(3a)' ) 'The ',xclibxc(ii+1:), &
4786 : 0 : & ' functional (read from PAW-XML file) was not found in the libXC library!'
4787 : 0 : LIBPAW_ERROR(msg)
4788 : : end if
4789 : 0 : pspxc=pspxc-id
4790 : : #else
4791 : : msg='Cannot use LibXC functional because ABINIT is not compiled with LibXC !'
4792 : : LIBPAW_ERROR(msg)
4793 : : #endif
4794 : : ! To be eliminated later (temporary)
4795 [ # # ]: 0 : else if(trim(psxml%xc_functional%functionaltype)=='LIBXC')then
4796 : : #if defined LIBPAW_HAVE_LIBXC
4797 : 0 : xclibxc=trim(psxml%xc_functional%name)
4798 : 0 : read(unit=xclibxc,fmt=*) pspxc
4799 : 0 : pspxc=-pspxc
4800 : : #else
4801 : : msg='Cannot use LibXC functional because ABINIT is not compiled with LibXC !'
4802 : : LIBPAW_ERROR(msg)
4803 : : #endif
4804 : : else
4805 : 0 : write(msg, '(3a)') 'Unknown XC functional in psp file: ',trim(xclibxc),' !'
4806 : 0 : LIBPAW_ERROR(msg)
4807 : : end if
4808 : : end select
4809 : :
4810 : 511 : end subroutine pawpsp_read_header_xml
4811 : : !!***
4812 : :
4813 : : !-------------------------------------------------------------------------
4814 : :
4815 : : !!****f* m_pawpsp/pawpsp_read_pawheader
4816 : : !! NAME
4817 : : !! pawpsp_read_pawheader
4818 : : !!
4819 : : !! FUNCTION
4820 : : !!
4821 : : !! INPUTS
4822 : : !!
4823 : : !! OUTPUT
4824 : : !!
4825 : : !! SIDE EFFECTS
4826 : : !!
4827 : : !! NOTES
4828 : : !!
4829 : : !! SOURCE
4830 : :
4831 : 511 : subroutine pawpsp_read_pawheader(basis_size,lmax,lmn_size,&
4832 : : & l_size,mesh_size,pspversion,psxml,rpaw,rshp,shape_type)
4833 : :
4834 : : !Arguments ------------------------------------
4835 : : !scalars
4836 : : integer,intent(in):: lmax
4837 : : integer,intent(out):: basis_size,mesh_size,lmn_size,l_size
4838 : : integer,intent(out):: pspversion,shape_type
4839 : : real(dp),intent(out)::rpaw,rshp
4840 : : type(paw_setup_t),intent(in) :: psxml
4841 : : !Local variables-------------------------------
4842 : : integer::il
4843 : :
4844 : : ! *************************************************************************
4845 : :
4846 : : !All of this was moved from pawpsxml2ab,
4847 : : !basis_size
4848 : 511 : basis_size=psxml%valence_states%nval
4849 : : !mesh_size
4850 [ + + ]: 1178 : do il=1,psxml%ngrid
4851 [ + + ]: 667 : if(psxml%radial_grid(il)%id==psxml%idgrid) &
4852 : 1022 : & mesh_size=psxml%radial_grid(il)%iend-psxml%radial_grid(il)%istart+1
4853 : : end do
4854 : : !lmn_size:
4855 : 511 : lmn_size=0
4856 [ + + ]: 2786 : do il=1,psxml%valence_states%nval
4857 : 2786 : lmn_size=lmn_size+2*psxml%valence_states%state(il)%ll+1
4858 : : end do
4859 : : !lsize
4860 : 511 : l_size=2*lmax+1
4861 : : !pspversion
4862 : 511 : pspversion=10
4863 : : !rpaw:
4864 : 511 : rpaw=0.d0
4865 [ + + ]: 511 : if (psxml%rpaw<0.d0) then
4866 [ + + ]: 212 : do il=1,psxml%valence_states%nval
4867 [ + + ]: 212 : if(psxml%valence_states%state(il)%rc>rpaw) rpaw=psxml%valence_states%state(il)%rc
4868 : : end do
4869 : : else
4870 : 470 : rpaw=psxml%rpaw
4871 : : end if
4872 : : !shape_type, rshp:
4873 : 514 : select case(trim(psxml%shape_function%gtype))
4874 : : case('gauss')
4875 : 3 : shape_type=1
4876 : 3 : rshp=rpaw
4877 : : case('bessel')
4878 : 98 : shape_type=3
4879 : 98 : rshp=psxml%shape_function%rc
4880 : : case('sinc')
4881 : 408 : shape_type=2
4882 : 408 : rshp=psxml%shape_function%rc
4883 : : case('exp')
4884 : 0 : shape_type=1
4885 : 0 : rshp=rpaw
4886 : : case('num')
4887 : 2 : shape_type=-1
4888 [ + + + - : 511 : rshp=rpaw
+ - ]
4889 : : end select
4890 : :
4891 : 511 : end subroutine pawpsp_read_pawheader
4892 : : !!***
4893 : :
4894 : : !-------------------------------------------------------------------------
4895 : :
4896 : : !!****f* m_pawpsp/pawpsp_bcast
4897 : : !! NAME
4898 : : !! pawpsp_bcast
4899 : : !!
4900 : : !! FUNCTION
4901 : : !! Communicate paw data to all processors
4902 : : !!
4903 : : !! INPUTS
4904 : : !! comm_mpi= communicator used to broadcast data
4905 : : !! lnmax= Max. number of (l,n) components over all type of psps
4906 : : !! mqgrid_ff= dimension of ffspl
4907 : : !! mqgrid_vl= dimension of vlspl
4908 : : !!
4909 : : !! OUTPUT
4910 : : !! epsatm=$ (4\pi)\int_0^\infty [r^2 (V(r)+\frac{Zv}{r}) dr]$(hartree)
4911 : : !! ffspl(mqgrid_ff,2,lnmax)=Kleinman-Bylander form factor f_l(q) and derivative
4912 : : !! pawrad=<type pawrad_type>
4913 : : !! pawtab=<type pawtab_type>
4914 : : !! vlspl(mqgrid_vl,2)=q^2 Vloc(q) and second derivatives from spline fit
4915 : : !! xcccrc=XC core correction cutoff radius (bohr) from psp file
4916 : : !!
4917 : : !! SOURCE
4918 : :
4919 [ - + - + ]: 284 : subroutine pawpsp_bcast(comm_mpi,epsatm,ffspl,pawrad,pawtab,vlspl,xcccrc)
4920 : :
4921 : : !Arguments ------------------------------------
4922 : : integer,intent(in) :: comm_mpi
4923 : : real(dp),intent(inout) :: epsatm,xcccrc
4924 : : real(dp),intent(inout) :: ffspl(:,:,:),vlspl(:,:)
4925 : : type(pawrad_type),intent(inout) :: pawrad
4926 : : type(pawtab_type),intent(inout) :: pawtab
4927 : :
4928 : : !Local variables-------------------------------
4929 : : integer :: ierr,ii,me,nn_dpr
4930 : : integer :: siz_ffspl,siz1_ffspl,siz2_ffspl,siz3_ffspl,siz_vlspl,siz1_vlspl,siz2_vlspl
4931 : : integer,allocatable :: list_int(:)
4932 : 284 : real(dp),allocatable :: list_dpr(:)
4933 : :
4934 : : !*************************************************************************
4935 : :
4936 : 284 : me=xmpi_comm_rank(comm_mpi)
4937 : :
4938 : : !Broadcast pawrad
4939 : 284 : call pawrad_bcast(pawrad,comm_mpi)
4940 : :
4941 : : !Broadcast pawtab (only data read from file)
4942 : 284 : call pawtab_bcast(pawtab,comm_mpi,only_from_file=.true.)
4943 : :
4944 : : !Broadcast the sizes of the arrays
4945 [ - + ]: 284 : LIBPAW_ALLOCATE(list_int,(5))
4946 [ + + ]: 284 : if (me==0) then
4947 : 72 : siz1_vlspl=size(vlspl,1); list_int(1)=siz1_vlspl
4948 : 72 : siz2_vlspl=size(vlspl,2); list_int(2)=siz2_vlspl
4949 : 72 : siz1_ffspl=size(ffspl,1); list_int(3)=siz1_ffspl
4950 : 72 : siz2_ffspl=size(ffspl,2); list_int(4)=siz2_ffspl
4951 : 72 : siz3_ffspl=size(ffspl,3); list_int(5)=siz3_ffspl
4952 : : end if
4953 : 284 : call xmpi_bcast(list_int,0,comm_mpi,ierr)
4954 [ + + ]: 284 : if (me/=0) then
4955 : 212 : siz1_vlspl=list_int(1)
4956 : 212 : siz2_vlspl=list_int(2)
4957 : 212 : siz1_ffspl=list_int(3)
4958 : 212 : siz2_ffspl=list_int(4)
4959 : 212 : siz3_ffspl=list_int(5)
4960 : : end if
4961 : 284 : siz_vlspl=siz1_vlspl*siz2_vlspl
4962 : 284 : siz_ffspl=siz1_ffspl*siz2_ffspl*siz3_ffspl
4963 [ - + ]: 284 : LIBPAW_DEALLOCATE(list_int)
4964 : :
4965 : : !Broadcast the reals
4966 : 284 : nn_dpr=2+siz_vlspl+siz_ffspl
4967 [ - + + - : 852 : LIBPAW_ALLOCATE(list_dpr,(nn_dpr))
+ - + - -
+ - + ]
4968 [ + + ]: 284 : if (me==0) then
4969 : 72 : ii=1
4970 : 72 : list_dpr(ii)=epsatm ;ii=ii+1
4971 : 72 : list_dpr(ii)=xcccrc ;ii=ii+1
4972 [ + + ]: 144 : list_dpr(ii:ii+siz_vlspl-1)=reshape(vlspl,(/siz_vlspl/)) ;ii=ii+siz_vlspl
4973 [ + + ]: 144 : list_dpr(ii:ii+siz_ffspl-1)=reshape(ffspl,(/siz_ffspl/)) ;ii=ii+siz_ffspl
4974 : : end if
4975 : 284 : call xmpi_bcast(list_dpr,0,comm_mpi,ierr)
4976 [ + + ]: 284 : if (me/=0) then
4977 : 212 : ii=1
4978 : 212 : epsatm=list_dpr(ii) ;ii=ii+1
4979 : 212 : xcccrc=list_dpr(ii) ;ii=ii+1
4980 [ + + ]: 636 : vlspl=reshape(list_dpr(ii:ii+siz_vlspl-1),(/siz1_vlspl,siz2_vlspl/))
4981 : 212 : ii=ii+siz_vlspl
4982 [ + + ]: 848 : ffspl=reshape(list_dpr(ii:ii+siz_ffspl-1),(/siz1_ffspl,siz2_ffspl,siz3_ffspl/))
4983 : 212 : ii=ii+siz_ffspl
4984 : : end if
4985 [ - + ]: 284 : LIBPAW_DEALLOCATE(list_dpr)
4986 : :
4987 : 284 : end subroutine pawpsp_bcast
4988 : : !!***
4989 : :
4990 : : !-------------------------------------------------------------------------
4991 : :
4992 : : !!****f* m_pawpsp/pawpsp_main
4993 : : !! NAME
4994 : : !! pawpsp_main
4995 : : !!
4996 : : !! FUNCTION
4997 : : !! Reads a PAW dataset (atomic data)
4998 : : !!
4999 : : !! INPUTS
5000 : : !! filpsp=name of the file containing the PAW dataset
5001 : : !! usewvl=1 if we use a wavelet basis, 0 other wise (plane waves)
5002 : : !! icoulomb=1 if we use a Poisson routine with wavelets, 0 otherwise
5003 : : !! ixc=index of the XC correlation functional
5004 : : !! xclevel=type of XC functional (1=LDA, 2=GGA, ...)
5005 : : !! pawxcdev=order of the developement of the PAW on-site terms
5006 : : !! (0: full calculation, 1: order 1, 2:order 2)
5007 : : !! usexcnhat=flag controlling the use of compensation charge (nhat) in XC potential
5008 : : !! qgrid_ff=size of the mesh for the sin FFT transform of the non-local projectors (form factors)
5009 : : !! (plane waves only, 0 otherwise)
5010 : : !! qgrid_vl=size of the mesh for the sin FFT transform of the local potential
5011 : : !! (plane waves only, 0 otherwise)
5012 : : !! ffspl=sin FFT transform of the non-local projectors (form factors) (plane waves only)
5013 : : !! vlspl=sin FFT transform of the local potential (plane waves only)
5014 : : !! epsatm=$ 4\pi\int[r^2 (V(r)+\frac{Zv}{r}dr]$.
5015 : : !! xcccrc=XC core correction cutoff radius (bohr)
5016 : : !! zionpsp=valence of atom as specified in input file
5017 : : !! znuclpsp=atomic number of atom as specified in input file
5018 : : !! ===== Optional arguments for wvl =====
5019 : : !! [wvl_ngauss]
5020 : : !! ===== Other optional arguments =====
5021 : : !! [psxml]=datastructure containing a XMP PAW dataset
5022 : : !! [comm_mpi]=MPI communicator
5023 : : !! [xc_denpos]=tolerance on density for the calculation of XC potential
5024 : : !! (if density<xc_denpos, density=zero)
5025 : : !! [xc_taupos]=tolerance on kinetic energy density for the calculation of XC potential (mGGA)
5026 : : !! [el_temp]=electronic temperature (hartree)
5027 : : !!
5028 : : !! OUTPUT
5029 : : !! pawrad <type(pawrad_type)>=data containing PAW radial grid information
5030 : : !! pawtab <type(pawtab_type)>=data containing the PAW dataset (partial waves...)
5031 : : !!
5032 : : !! SIDE EFFECTS
5033 : : !!
5034 : : !! NOTES
5035 : : !!
5036 : : !!
5037 : : !! SOURCE
5038 : :
5039 : 0 : subroutine pawpsp_main( &
5040 : : & pawrad,pawtab,&
5041 : : & filpsp,usewvl,icoulomb,hyb_mixing,ixc,xclevel,pawxcdev,usexcnhat,&
5042 [ # # # # : 0 : & qgrid_ff,qgrid_vl,ffspl,vlspl,epsatm,xcccrc,zionpsp,znuclpsp,&
# # # # ]
5043 : : & wvl_ngauss,psxml,comm_mpi,xc_denpos,xc_taupos,el_temp) ! Optional arguments
5044 : :
5045 : : !Arguments ------------------------------------
5046 : : !scalars
5047 : : integer,intent(in) :: icoulomb,ixc
5048 : : integer,intent(in) :: pawxcdev,usewvl,usexcnhat,xclevel
5049 : : integer,optional,intent(in) :: comm_mpi
5050 : : real(dp),intent(in):: hyb_mixing,zionpsp,znuclpsp
5051 : : real(dp),optional,intent(in) :: xc_denpos,xc_taupos,el_temp
5052 : : real(dp),intent(out) :: epsatm,xcccrc
5053 : : character(len=fnlen),intent(in):: filpsp ! name of the psp file
5054 : : type(pawrad_type),intent(inout) :: pawrad
5055 : : type(pawtab_type),intent(inout) :: pawtab
5056 : : type(paw_setup_t),optional,intent(in) :: psxml
5057 : : !arrays
5058 : : integer,optional,intent(in) :: wvl_ngauss(2)
5059 : : real(dp),intent(in) :: qgrid_ff(:),qgrid_vl(:)
5060 : : real(dp),intent(inout) :: ffspl(:,:,:)
5061 : : real(dp),intent(out) :: vlspl(:,:)
5062 : :
5063 : : !Local variables-------------------------------
5064 : : integer :: has_coretau,has_tproj,has_wvl,ipsp,lmax,lloc,lnmax,mmax,me,mqgrid_ff,mqgrid_vl
5065 : : integer :: pspcod,pspxc,usexml
5066 : : real(dp),parameter :: xc_denpos_default=tol14
5067 : : real(dp) :: my_xc_denpos,my_el_temp,my_xc_taupos,r2well,zion,znucl
5068 : : character(len=500) :: msg
5069 : : type(pawpsp_header_type) :: pawpsp_header
5070 : : !arrays
5071 : :
5072 : : ! *************************************************************************
5073 : :
5074 : : !Check consistency of parameters
5075 [ # # # # ]: 0 : if (icoulomb/= 0.or.usewvl==1) then
5076 [ # # ]: 0 : if (.not.present(wvl_ngauss)) then
5077 : 0 : msg='usewvl==1 or icoulomb/=0: a mandatory argument is missing!'
5078 : 0 : LIBPAW_BUG(msg)
5079 : : end if
5080 : : end if
5081 : :
5082 : 0 : mqgrid_ff=size(qgrid_ff)
5083 : 0 : mqgrid_vl=size(qgrid_vl)
5084 : 0 : lnmax=size(ffspl,3)
5085 [ # # # # ]: 0 : if (size(ffspl,1)/=mqgrid_ff.or.size(ffspl,2)/=2) then
5086 : 0 : msg='invalid sizes for ffspl!'
5087 : 0 : LIBPAW_BUG(msg)
5088 : : end if
5089 [ # # # # ]: 0 : if (size(vlspl,1)/=mqgrid_vl.or.size(vlspl,2)/=2) then
5090 : 0 : msg='invalid sizes for vlspl!'
5091 : 0 : LIBPAW_BUG(msg)
5092 : : end if
5093 : :
5094 [ # # ]: 0 : my_xc_denpos=xc_denpos_default;if (present(xc_denpos)) my_xc_denpos=xc_denpos
5095 [ # # ]: 0 : my_xc_taupos=my_xc_denpos;if (present(xc_taupos)) my_xc_taupos=xc_taupos
5096 : 0 : my_el_temp=merge(el_temp,zero,present(el_temp))
5097 : 0 : pawtab%usexcnhat=usexcnhat
5098 [ # # ]: 0 : me=0;if (present(comm_mpi))me=xmpi_comm_rank(comm_mpi)
5099 : :
5100 [ # # # # ]: 0 : has_wvl=0; if (usewvl==1.or.icoulomb/=0) has_wvl=1
5101 [ # # ]: 0 : has_tproj=0; if (usewvl==1) has_tproj=1
5102 [ # # ]: 0 : has_coretau=0 ; if (pawxc_get_usekden(ixc)>=1) has_coretau=1
5103 : 0 : call pawtab_set_flags(pawtab,has_coretau=has_coretau,has_tvale=1,has_wvl=has_wvl,has_tproj=has_tproj)
5104 : :
5105 [ # # ]: 0 : if(me==0) then
5106 : 0 : write(msg, '(a,t38,a)' )'- pspatm: opening atomic psp file',trim(filpsp)
5107 : 0 : call wrtout(ab_out, msg,'COLL')
5108 : 0 : call wrtout(std_out, msg,'COLL')
5109 : :
5110 : : ! This checks if file is xml or UPF
5111 : : ! It sets usexml as well
5112 : 0 : call pawpsp_check_xml_upf(filpsp)
5113 : :
5114 : : ! ----------------------------------------------------------------------------
5115 [ # # ]: 0 : if (usexml /= 1) then
5116 : : ! Open the atomic data file, and read the three first lines
5117 : 0 : open (unit=tmp_unit,file=filpsp,form='formatted',status='old')
5118 : 0 : rewind (unit=tmp_unit)
5119 : : ! Read first 3 lines of psp file:
5120 : : call pawpsp_read_header(tmp_unit,lloc,lmax,mmax,pspcod,&
5121 : 0 : & pspxc,r2well,zion,znucl)
5122 : :
5123 [ # # ]: 0 : else if (usexml == 1 .and. present(psxml)) then
5124 : : write(msg,'(a,a)') &
5125 : 0 : & '- pawpsp : Reading pseudopotential header in XML form from ', trim(filpsp)
5126 : 0 : call wrtout(ab_out,msg,'COLL')
5127 : 0 : call wrtout(std_out, msg,'COLL')
5128 : :
5129 : : ! Return header information
5130 : : call pawpsp_read_header_xml(lloc,lmax,pspcod,&
5131 : 0 : & pspxc,psxml,r2well,zion,znucl)
5132 : : ! Fill in pawpsp_header object:
5133 : : call pawpsp_read_pawheader(pawpsp_header%basis_size,&
5134 : : & lmax,pawpsp_header%lmn_size,&
5135 : : & pawpsp_header%l_size,pawpsp_header%mesh_size,&
5136 : : & pawpsp_header%pawver,psxml,&
5137 : 0 : & pawpsp_header%rpaw,pawpsp_header%rshp,pawpsp_header%shape_type)
5138 : : end if
5139 : :
5140 : : ! Check data for consistency against main routine input
5141 : 0 : call pawpsp_consistency()
5142 : :
5143 : : ! Read rest of the PSP file
5144 [ # # ]: 0 : if (pspcod==7) then
5145 : : ! ABINIT proprietary format
5146 : : call pawpsp_7in(epsatm,ffspl,icoulomb,hyb_mixing,ixc,&
5147 : : & lmax,lnmax,mmax,mqgrid_ff,mqgrid_vl,&
5148 : : & pawrad,pawtab,pawxcdev,qgrid_ff,qgrid_vl,&
5149 : : & usewvl,usexcnhat,vlspl,xcccrc,xclevel,my_xc_denpos,zion,znucl,&
5150 [ # # # # : 0 : & xc_taupos=my_xc_taupos,el_temp=my_el_temp)
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # #
# ]
5151 : :
5152 [ # # ]: 0 : else if (pspcod==17)then
5153 : : ! XML format
5154 : 0 : ipsp=1
5155 : : call pawpsp_17in(epsatm,ffspl,icoulomb,ipsp,hyb_mixing,ixc,lmax,&
5156 : : & lnmax,mmax,mqgrid_ff,mqgrid_vl,pawpsp_header,pawrad,pawtab,&
5157 : : & pawxcdev,qgrid_ff,qgrid_vl,usewvl,usexcnhat,vlspl,xcccrc,&
5158 [ # # # # : 0 : & xclevel,my_xc_denpos,zion,znucl,xc_taupos=my_xc_taupos,el_temp=my_el_temp)
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # #
# ]
5159 : :
5160 : : end if
5161 : : end if!me==0
5162 : :
5163 : 0 : close(unit=tmp_unit)
5164 : :
5165 : 0 : write(msg,'(3a)') ' pawpsp: atomic psp has been read ',&
5166 : 0 : & ' and splines computed',ch10
5167 : 0 : call wrtout(ab_out,msg,'COLL')
5168 : 0 : call wrtout(std_out, msg,'COLL')
5169 : :
5170 : : !Communicate PAW objects
5171 [ # # ]: 0 : if(present(comm_mpi)) then
5172 [ # # ]: 0 : if(xmpi_comm_size(comm_mpi)>1) then
5173 : 0 : call pawpsp_bcast(comm_mpi,epsatm,ffspl,pawrad,pawtab,vlspl,xcccrc)
5174 : : end if
5175 : : end if
5176 : :
5177 : : !WVL+PAW:
5178 [ # # # # ]: 0 : if(icoulomb/=0.or.usewvl==1) then
5179 [ # # ]: 0 : if(present(comm_mpi))then
5180 : 0 : call pawpsp_wvl(filpsp,pawrad,pawtab,usewvl,wvl_ngauss,comm_mpi)
5181 : : else
5182 : 0 : call pawpsp_wvl(filpsp,pawrad,pawtab,usewvl,wvl_ngauss)
5183 : : end if
5184 : : end if
5185 : :
5186 : : contains
5187 : : !!***
5188 : :
5189 : : !-------------------------------------------------------------------------
5190 : :
5191 : : !!****f* pawpsp_main/pawpsp_check_xml_upf
5192 : : !! NAME
5193 : : !! pawpsp_main_checks
5194 : : !!
5195 : : !! FUNCTION
5196 : : !!
5197 : : !! INPUTS
5198 : : !!
5199 : : !! OUTPUT
5200 : : !!
5201 : : !! SIDE EFFECTS
5202 : : !!
5203 : : !! NOTES
5204 : : !!
5205 : : !! SOURCE
5206 : :
5207 : :
5208 : 0 : subroutine pawpsp_check_xml_upf(filpsp)
5209 : :
5210 : : !Arguments ------------------------------------
5211 : : !scalars
5212 : : character(len=fnlen),intent(in):: filpsp ! name of the psp file
5213 : :
5214 : : !Local variables-------------------------------
5215 : : integer :: unt
5216 : : character(len=70):: testxml
5217 : :
5218 : : ! *************************************************************************
5219 : :
5220 : : ! Check if the file pseudopotential file is written in XML
5221 : 0 : usexml = 0
5222 : 0 : unt = libpaw_get_free_unit()
5223 : 0 : open (unit=unt,file=filpsp,form='formatted',status='old',action="read")
5224 : 0 : rewind (unit=unt)
5225 : 0 : read(unt,*) testxml
5226 [ # # ]: 0 : if(testxml(1:5)=='<?xml')then
5227 : 0 : usexml = 1
5228 : 0 : read(unt,*) testxml
5229 [ # # ]: 0 : if(testxml(1:4)/='<paw')then
5230 : 0 : msg='Reading a NC pseudopotential for a PAW calculation?'
5231 : 0 : LIBPAW_BUG(msg)
5232 : : end if
5233 : : else
5234 : 0 : usexml = 0
5235 : : end if
5236 : 0 : close (unit=unt)
5237 : :
5238 : : ! Check if pseudopotential file is a Q-espresso UPF file
5239 : 0 : unt = libpaw_get_free_unit()
5240 : 0 : open (unit=unt,file=filpsp,form='formatted',status='old',action="read")
5241 : 0 : rewind (unit=unt)
5242 : 0 : read(unt,*) testxml ! just a string, no relation to xml.
5243 [ # # ]: 0 : if(testxml(1:9)=='<PP_INFO>')then
5244 : 0 : msg='UPF format not allowed with PAW (USPP part not read yet)!'
5245 : 0 : LIBPAW_ERROR(msg)
5246 : : end if
5247 : 0 : close (unit=unt)
5248 : :
5249 : 0 : end subroutine pawpsp_check_xml_upf
5250 : : !!***
5251 : :
5252 : : !-------------------------------------------------------------------------
5253 : :
5254 : : !!****f* pawpsp_main/pawpsp_consistency
5255 : : !! NAME
5256 : : !! pawpsp_consistency
5257 : : !!
5258 : : !! FUNCTION
5259 : : !!
5260 : : !! INPUTS
5261 : : !!
5262 : : !! OUTPUT
5263 : : !!
5264 : : !! SIDE EFFECTS
5265 : : !!
5266 : : !! NOTES
5267 : : !!
5268 : : !! SOURCE
5269 : :
5270 : :
5271 : 0 : subroutine pawpsp_consistency()
5272 : :
5273 : : ! *************************************************************************
5274 : :
5275 : : !Check pspcod=7 or 17
5276 [ # # ]: 0 : if(pspcod/=7 .and. pspcod/=17)then
5277 : : write(msg, '(a,i2,a,a)' )&
5278 : 0 : & 'In reading atomic psp file, finds pspcod=',pspcod,ch10,&
5279 : 0 : & 'This is not an allowed value within PAW.'
5280 : 0 : LIBPAW_BUG(msg)
5281 : : end if
5282 : :
5283 : : !Does nuclear charge znuclpsp agree with psp input znucl
5284 [ # # ]: 0 : if (abs(znuclpsp-znucl)>tol8) then
5285 : : write(msg, '(a,f10.5,2a,f10.5,5a)' )&
5286 : 0 : & 'Pseudopotential file znucl=',znucl,ch10,&
5287 : 0 : & 'does not equal input znuclpsp=',znuclpsp,' better than 1e-08 .',ch10,&
5288 : 0 : & 'znucl is read from the psp file in pspatm_abinit, while',ch10,&
5289 : 0 : & 'znuclpsp is read in iofn2.'
5290 : 0 : LIBPAW_BUG(msg)
5291 : : end if
5292 : :
5293 : : !Does nuclear charge zionpsp agree with psp input zion
5294 [ # # ]: 0 : if (abs(zionpsp-zion)>tol8) then
5295 : : write(msg, '(a,f10.5,2a,f10.5,5a)' )&
5296 : 0 : & 'Pseudopotential file zion=',zion,ch10,&
5297 : 0 : & 'does not equal input zionpsp=',zionpsp,' better than 1e-08 .',ch10,&
5298 : 0 : & 'zion is read from the psp file in pawpsp_main, while',ch10,&
5299 : 0 : & 'zionpsp is read in iofn2.'
5300 : 0 : LIBPAW_BUG(msg)
5301 : : end if
5302 : :
5303 : : !Check several choices for ixc against pspxc
5304 : : !ixc is from ABINIT code; pspxc is from atomic psp file
5305 [ # # ]: 0 : if (ixc==0) then
5306 : 0 : msg='Note that input ixc=0 => no xc is being used.'
5307 : 0 : LIBPAW_WARNING(msg)
5308 [ # # ]: 0 : else if(ixc/=pspxc) then
5309 : : write(msg, '(a,i8,a,a,a,i8,a,a,a,a,a,a,a,a,a,a)' ) &
5310 : 0 : & 'Pseudopotential file pspxc=',pspxc,',',ch10,&
5311 : 0 : & 'not equal to input ixc=',ixc,'.',ch10,&
5312 : 0 : & 'These parameters must agree to get the same xc ',ch10,&
5313 : 0 : & 'in ABINIT code as in psp construction.',ch10,&
5314 : 0 : & 'Action : check psp design or input file.',ch10,&
5315 : 0 : & 'Assume experienced user. Execution will continue.',ch10
5316 : 0 : LIBPAW_WARNING(msg)
5317 : : end if
5318 : :
5319 [ # # ]: 0 : if (lloc>lmax ) then
5320 : : write(msg, '(a,2i12,a,a,a,a)' )&
5321 : 0 : & 'lloc,lmax=',lloc,lmax,ch10,&
5322 : 0 : & 'chosen l of local psp exceeds range from input data.',ch10,&
5323 : 0 : & 'Action : check pseudopotential input file.'
5324 : 0 : LIBPAW_ERROR(msg)
5325 : : end if
5326 : :
5327 : 0 : end subroutine pawpsp_consistency
5328 : : !!***
5329 : :
5330 : : end subroutine pawpsp_main
5331 : : !!***
5332 : :
5333 : : !-------------------------------------------------------------------------
5334 : :
5335 : 0 : end module m_pawpsp
5336 : : !!***
|
