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