Branch data Line data Source code
1 : : !!****m* ABINIT/m_initylmg
2 : : !! NAME
3 : : !! m_initylmg
4 : : !!
5 : : !! FUNCTION
6 : : !! Calculate the real spherical harmonics Ylm (and gradients)
7 : : !! over a set of (reciprocal space) (k+G) vectors
8 : : !!
9 : : !! COPYRIGHT
10 : : !! Copyright (C) 1998-2026 ABINIT group (FJ, MT)
11 : : !! This file is distributed under the terms of the
12 : : !! GNU General Public License, see ~abinit/COPYING
13 : : !! or http://www.gnu.org/copyleft/gpl.txt .
14 : : !!
15 : : !! SOURCE
16 : :
17 : : #if defined HAVE_CONFIG_H
18 : : #include "config.h"
19 : : #endif
20 : :
21 : : #include "abi_common.h"
22 : :
23 : : module m_initylmg
24 : :
25 : : use defs_basis
26 : : use m_abicore
27 : : use m_errors
28 : : use m_xmpi
29 : :
30 : : use defs_abitypes, only : MPI_type
31 : : use m_paw_sphharm, only : ass_leg_pol, plm_dtheta, plm_dphi, plm_coeff
32 : : use m_mpinfo, only : proc_distrb_cycle, destroy_mpi_enreg, initmpi_seq
33 : :
34 : : implicit none
35 : :
36 : : private
37 : : !!***
38 : :
39 : : public :: initylmg ! Calculate real spherical harmonics Ylm (and gradients) for several k-points
40 : : public :: initylmg_k ! Simplified interface to compute Ylm for a single k-point.
41 : : !!***
42 : :
43 : : contains
44 : : !!***
45 : :
46 : : !!****f* ABINIT/initylmg
47 : : !! NAME
48 : : !! initylmg
49 : : !!
50 : : !! FUNCTION
51 : : !! Calculate the real spherical harmonics Ylm (and gradients)
52 : : !! over a set of (reciprocal space) (k+G) vectors
53 : : !!
54 : : !! INPUTS
55 : : !! gprimd(3,3)=dimensional reciprocal space primitive translations (b^-1)
56 : : !! kg(3,mpw)=integer coordinates of G vectors in basis sphere
57 : : !! kptns(3,nkpt)=k points in terms of reciprocal translations
58 : : !! mkmem =number of k points treated by this node
59 : : !! mpi_enreg=information about MPI parallelization
60 : : !! mpsang=1+maximum angular momentum for nonlocal pseudopotential
61 : : !! mpw =maximum number of planewaves in basis sphere (large number)
62 : : !! nband(nkpt*nsppol)=number of bands at each k point
63 : : !! nkpt =number of k points
64 : : !! npwarr(nkpt)=array holding npw for each k point
65 : : !! nsppol=1 for unpolarized, 2 for polarized
66 : : !! optder= 0=compute Ylm(K)
67 : : !! 1=compute Ylm(K) and dYlm/dKi
68 : : !! 2=compute Ylm(K), dYlm/dKi and d2Ylm/dKidKj
69 : : !! -1=compute only dYlm/dKi
70 : : !! rprimd(3,3)=dimensional primitive translations in real space (bohr)
71 : : !!
72 : : !! OUTPUT
73 : : !! if (optder>=0)
74 : : !! ylm(mpw*mkmem,mpsang*mpsang) = real spherical harmonics for each G and k point
75 : : !! if (optder>=1 or optder==-1)
76 : : !! ylm_gr(mpw*mkmem,1:3,mpsang*mpsang)= gradients of real
77 : : !! spherical harmonics wrt (G+k) in reduced coordinates
78 : : !! if (optder>=2)
79 : : !! ylm_gr(mpw*mkmem,4:9,mpsang*mpsang)= second gradients of
80 : : !! real spherical harmonics wrt (G+k) in reduced coordinates
81 : : !!
82 : : !! NOTES
83 : : !! Remember the expression of complex spherical harmonics:
84 : : !! $Y_{lm}(%theta ,%phi)=sqrt{{(2l+1) over (4 %pi)}
85 : : !! {fact(l-m) over fact(l+m)} } P_l^m(cos(%theta))
86 : : !! func e^{i m %phi}$
87 : : !! Remember the expression of real spherical harmonics as
88 : : !! linear combination of complex spherical harmonics:
89 : : !! $Yr_{lm}(%theta ,%phi)=(Re{Y_{l-m}}+(-1)^m Re{Y_{lm}})/sqrt{2}
90 : : !! $Yr_{l-m}(%theta ,%phi)=(Im{Y_{l-m}}-(-1)^m Im{Y_{lm}})/sqrt{2}
91 : : !!
92 : : !! SOURCE
93 : :
94 : 8717 : subroutine initylmg(gprimd, kg, kptns, mkmem, mpi_enreg, mpsang, mpw, &
95 : 8717 : nband, nkpt, npwarr, nsppol, optder, rprimd, ylm, ylm_gr)
96 : :
97 : : !Arguments ------------------------------------
98 : : !scalars
99 : : integer,intent(in) :: mkmem,mpsang,mpw,nkpt,nsppol,optder
100 : : type(MPI_type),intent(in) :: mpi_enreg
101 : : !arrays
102 : : integer,intent(in) :: kg(3,mpw*mkmem),nband(nkpt*nsppol)
103 : : integer,intent(in) :: npwarr(nkpt)
104 : : real(dp),intent(in) :: gprimd(3,3),kptns(3,nkpt),rprimd(3,3)
105 : : real(dp),intent(out) :: ylm(mpw*mkmem,mpsang*mpsang)
106 : : real(dp),intent(out) :: ylm_gr(mpw*mkmem,3+6*(optder/2),mpsang*mpsang)
107 : :
108 : : !Local variables ------------------------------
109 : : !scalars
110 : : integer :: dimgr,ia,ib,ii,ikg,ikpt,ilang,ipw
111 : : integer :: jj,kk,l0,ll
112 : : integer :: me_distrb,mm,npw_k
113 : : real(dp),parameter :: tol=1.d-10
114 : : real(dp) :: cphi,ctheta,fact,onem,rr,sphi,stheta,work1,work2
115 : : real(dp) :: xx,ylmcst,ylmcst2
116 : : real(dp) :: yy,zz
117 : : !character(len=500) :: message
118 : : !arrays
119 : : integer,parameter :: alpha(6)=(/1,2,3,3,3,2/)
120 : : integer,parameter :: beta(6)=(/1,2,3,2,1,1/)
121 : 8717 : integer,allocatable :: kg_k(:,:)
122 : 17434 : real(dp) :: dphi(3),dtheta(3),iphase(mpsang-1),kpg(3)
123 : 17434 : real(dp) :: rphase(mpsang-1)
124 : 8717 : real(dp),allocatable :: blm(:,:)
125 : 8717 : real(dp),allocatable :: ylmgr2_cart(:,:,:),ylmgr2_tmp(:,:)
126 : 8717 : real(dp),allocatable :: ylmgr_cart(:,:)
127 : 8717 : real(dp),allocatable :: ylmgr_red(:,:)
128 : :
129 : : !*****************************************************************
130 : :
131 : : !Begin executable
132 : 8717 : me_distrb=mpi_enreg%me_kpt
133 : : !Initialisation of spherical harmonics (and gradients)
134 [ + + + + : 149327579 : if (optder>=0) ylm(:,:) =zero
+ + ]
135 [ + + + + : 441200094 : if (optder/=0) ylm_gr(:,:,:)=zero
+ + + + ]
136 : 8717 : dimgr=3+6*(optder/2)
137 : :
138 : : !Allocate some memory
139 [ + + ]: 8717 : if (optder/=0) then
140 [ - + ]: 3744 : ABI_MALLOC(ylmgr_cart,(3,2))
141 : : end if
142 [ + + ]: 8717 : if (optder/=0.and.optder/=2) then
143 [ - + ]: 3057 : ABI_MALLOC(ylmgr_red,(3,2))
144 : : end if
145 [ + + ]: 8717 : if (optder==2) then
146 [ - + ]: 687 : ABI_MALLOC(ylmgr2_cart,(3,3,2))
147 [ - + ]: 687 : ABI_MALLOC(ylmgr2_tmp,(3,3))
148 [ - + - + ]: 687 : ABI_MALLOC(ylmgr_red,(6,2))
149 [ - + + - : 2061 : ABI_MALLOC(blm,(5,mpsang*mpsang))
+ - + - -
+ - + ]
150 : : end if
151 : :
152 : : !Loop over k-points:
153 : 8717 : ikg=0
154 [ + + ]: 171223 : do ikpt=1,nkpt
155 : :
156 [ + + ]: 162506 : if(proc_distrb_cycle(mpi_enreg%proc_distrb,ikpt,1,nband(ikpt),-1,me_distrb)) cycle
157 : :
158 : :
159 : : ! Get k+G-vectors, for this k-point:
160 : 131204 : npw_k=npwarr(ikpt)
161 [ - + + - : 393612 : ABI_MALLOC(kg_k,(3,npw_k))
+ - + - -
+ - + ]
162 [ + + + + ]: 73202264 : kg_k(:,1:npw_k)=kg(:,1+ikg:npw_k+ikg)
163 : :
164 : : ! Special case for l=0
165 [ + + + + ]: 18302603 : if (optder>=0) ylm(1+ikg:npw_k+ikg,1)=1._dp/sqrt(four_pi)
166 [ + + + + : 53494193 : if (optder/=0) ylm_gr(1+ikg:npw_k+ikg,1:dimgr,1)=zero
+ + ]
167 : :
168 [ + + ]: 131204 : if (mpsang>1) then
169 : : ! Loop over all k+G
170 [ + + ]: 18374870 : do ipw=1,npw_k
171 : :
172 : : ! Load k+G
173 : 18243879 : kpg(1)=kptns(1,ikpt)+real(kg_k(1,ipw),dp)
174 : 18243879 : kpg(2)=kptns(2,ikpt)+real(kg_k(2,ipw),dp)
175 : 18243879 : kpg(3)=kptns(3,ikpt)+real(kg_k(3,ipw),dp)
176 : :
177 : : ! Calculate module of k+G
178 : 18243879 : xx=gprimd(1,1)*kpg(1)+gprimd(1,2)*kpg(2)+gprimd(1,3)*kpg(3)
179 : 18243879 : yy=gprimd(2,1)*kpg(1)+gprimd(2,2)*kpg(2)+gprimd(2,3)*kpg(3)
180 : 18243879 : zz=gprimd(3,1)*kpg(1)+gprimd(3,2)*kpg(2)+gprimd(3,3)*kpg(3)
181 : 18243879 : rr=sqrt(xx**2+yy**2+zz**2)
182 : :
183 : : ! Continue only for k+G<>0
184 [ + + ]: 18374870 : if (rr>tol) then
185 : :
186 : : ! Determine theta and phi
187 : 18243145 : cphi=one
188 : 18243145 : sphi=zero
189 : 18243145 : ctheta=zz/rr
190 : 18243145 : stheta=sqrt(abs((one-ctheta)*(one+ctheta)))
191 [ + + ]: 18243145 : if (stheta>tol) then
192 : 18228264 : cphi=xx/(rr*stheta)
193 : 18228264 : sphi=yy/(rr*stheta)
194 : : end if
195 [ + + ]: 49465785 : do mm=1,mpsang-1
196 : 31222640 : rphase(mm)=dreal(dcmplx(cphi,sphi)**mm)
197 : 49465785 : iphase(mm)=aimag(dcmplx(cphi,sphi)**mm)
198 : : end do
199 : :
200 : : ! Determine gradients of theta and phi
201 [ + + ]: 18243145 : if (optder/=0) then
202 : 9576926 : dtheta(1)=ctheta*cphi
203 : 9576926 : dtheta(2)=ctheta*sphi
204 : 9576926 : dtheta(3)=-stheta
205 : 9576926 : dphi(1)=-sphi
206 : 9576926 : dphi(2)=cphi
207 : 9576926 : dphi(3)=zero
208 : : end if
209 : :
210 : : ! COMPUTE Ylm(K)
211 : : ! ============================================
212 [ + + ]: 18243145 : if (optder>=0) then
213 : : ! Loop over angular momentum l
214 [ + + ]: 49267465 : do ilang=2,mpsang
215 : 31120686 : ll=ilang-1
216 : 31120686 : l0=ll**2+ll+1
217 : 31120686 : fact=1._dp/real(ll*(ll+1),dp)
218 : 31120686 : ylmcst=sqrt(real(2*ll+1,dp)/four_pi)
219 : : ! Special case m=0
220 : 31120686 : ylm(ikg+ipw,l0)=ylmcst*ass_leg_pol(ll,0,ctheta)
221 : : ! Compute for m>0
222 : 31120686 : onem=one
223 [ + + ]: 96170680 : do mm=1,ll
224 : 46903215 : onem=-onem
225 : 46903215 : work1=ylmcst*sqrt(fact)*onem*ass_leg_pol(ll,mm,ctheta)*sqrt(2._dp)
226 : 46903215 : ylm(ikg+ipw,l0+mm)=work1*rphase(mm)
227 : 46903215 : ylm(ikg+ipw,l0-mm)=work1*iphase(mm)
228 [ + + ]: 78023901 : if (mm/=ll) fact=fact/real((ll+mm+1)*(ll-mm),dp)
229 : : end do ! End loop over m
230 : : end do ! End loop over l
231 : : end if
232 : :
233 : : ! COMPUTE dYlm/dKi
234 : : ! ============================================
235 [ + + ]: 18243145 : if (optder/=0) then
236 : : ! Loop over angular momentum l
237 [ + + ]: 25209450 : do ilang=2,mpsang
238 : 15632524 : ll=ilang-1
239 : 15632524 : l0=ll**2+ll+1
240 : 15632524 : fact=1._dp/real(ll*(ll+1),dp)
241 : 15632524 : ylmcst=sqrt(real(2*ll+1,dp)/four_pi)/rr
242 : : ! === Special case m=0 ===
243 : : ! 1-compute gradients in cartesian coordinates
244 : 15632524 : work1=ylmcst*plm_dtheta(ll,0,ctheta)
245 [ + + ]: 62530096 : ylmgr_cart(1:3,1)=work1*dtheta(1:3)
246 : : ! 2-Transfer gradients into reduced coordinates
247 [ + + ]: 62530096 : do ii=1,3
248 : : ylmgr_red(ii,1)=(rprimd(1,ii)*ylmgr_cart(1,1)+&
249 : : & rprimd(2,ii)*ylmgr_cart(2,1)+&
250 : 62530096 : & rprimd(3,ii)*ylmgr_cart(3,1))
251 : : end do
252 : : ! 3-Store gradients
253 [ + + ]: 62530096 : ylm_gr(ikg+ipw,1:3,l0) =ylmgr_red(1:3,1)
254 : : ! === Compute for m>0 ===
255 : 15632524 : onem=one
256 [ + + ]: 47362269 : do mm=1,ll
257 : 22152819 : onem=-onem
258 : : ! 1-compute gradients in cartesian coordinates
259 : 22152819 : work1=ylmcst*sqrt(fact)*onem*plm_dtheta(ll,mm,ctheta)*sqrt(2._dp)
260 : 22152819 : work2=ylmcst*sqrt(fact)*onem*plm_dphi (ll,mm,ctheta)*sqrt(2._dp)
261 [ + + ]: 88611276 : ylmgr_cart(1:3,1)=rphase(mm)*work1*dtheta(1:3)-iphase(mm)*work2*dphi(1:3)
262 [ + + ]: 88611276 : ylmgr_cart(1:3,2)=iphase(mm)*work1*dtheta(1:3)+rphase(mm)*work2*dphi(1:3)
263 : : ! 2-Transfer gradients into reduced coordinates
264 [ + + ]: 66458457 : do kk=1,2
265 [ + + ]: 199375371 : do ii=1,3
266 : : ylmgr_red(ii,kk)=(rprimd(1,ii)*ylmgr_cart(1,kk)+&
267 : : & rprimd(2,ii)*ylmgr_cart(2,kk)+&
268 : 177222552 : & rprimd(3,ii)*ylmgr_cart(3,kk))
269 : : end do
270 : : end do
271 : : ! 3-Store gradients
272 [ + + ]: 88611276 : ylm_gr(ikg+ipw,1:3,l0+mm) =ylmgr_red(1:3,1)
273 [ + + ]: 88611276 : ylm_gr(ikg+ipw,1:3,l0-mm) =ylmgr_red(1:3,2)
274 [ + + ]: 37785343 : if (mm/=ll) fact=fact/real((ll+mm+1)*(ll-mm),dp)
275 : : end do ! End loop over m
276 : : end do ! End loop over l
277 : : end if
278 : :
279 : : ! COMPUTE d2Ylm/dKidKj
280 : : ! ============================================
281 [ + + ]: 18243145 : if (optder==2) then
282 : 4025645 : call plm_coeff(blm,mpsang,ctheta)
283 : : ! Loop over angular momentum l
284 [ + + ]: 11830143 : do ilang=2,mpsang
285 : 7804498 : ll=ilang-1
286 : 7804498 : l0=ll**2+ll+1
287 : 7804498 : fact=1._dp/real(ll*(ll+1),dp)
288 : 7804498 : ylmcst=sqrt(real(2*ll+1,dp)/four_pi)/(rr**2)
289 : : ! === Special case m=0 ===
290 : : ! 1-compute gradients in cartesian coordinates
291 : 7804498 : ylmgr2_cart(1,1,1)=ylmcst*(-blm(3,l0)*sphi*sphi+blm(4,l0)*cphi*cphi)
292 : 7804498 : ylmgr2_cart(2,2,1)=ylmcst*(-blm(3,l0)*cphi*cphi+blm(4,l0)*sphi*sphi)
293 : 7804498 : ylmgr2_cart(3,3,1)=ylmcst*blm(1,l0)
294 : 7804498 : ylmgr2_cart(3,1,1)=ylmcst*blm(2,l0)*cphi
295 : 7804498 : ylmgr2_cart(3,2,1)=ylmcst*blm(2,l0)*sphi
296 : 7804498 : ylmgr2_cart(2,1,1)=ylmcst*(blm(3,l0)+blm(4,l0))*sphi*cphi
297 : 7804498 : ylmgr2_cart(1,3,1)=ylmgr2_cart(3,1,1)
298 : 7804498 : ylmgr2_cart(1,2,1)=ylmgr2_cart(2,1,1)
299 : 7804498 : ylmgr2_cart(2,3,1)=ylmgr2_cart(3,2,1)
300 : : ! 2-Transfer gradients into reduced coordinates
301 [ + + ]: 31217992 : do jj=1,3
302 [ + + ]: 101458474 : do ii=1,3
303 : : ylmgr2_tmp(ii,jj)=(rprimd(1,jj)*ylmgr2_cart(1,ii,1)+&
304 : : & rprimd(2,jj)*ylmgr2_cart(2,ii,1)+&
305 : 93653976 : & rprimd(3,jj)*ylmgr2_cart(3,ii,1))
306 : : end do
307 : : end do
308 [ + + ]: 54631486 : do ii=1,6
309 : 46826988 : ia=alpha(ii);ib=beta(ii)
310 : : ylmgr_red(ii,1)=(rprimd(1,ia)*ylmgr2_tmp(1,ib)+&
311 : : & rprimd(2,ia)*ylmgr2_tmp(2,ib)+&
312 : 54631486 : & rprimd(3,ia)*ylmgr2_tmp(3,ib))
313 : : end do
314 [ + + ]: 54631486 : ylm_gr(ikg+ipw,4:9,l0) =ylmgr_red(1:6,1)
315 : : ! === Compute for m>0 ===
316 : 7804498 : onem=one
317 [ + + ]: 23743866 : do mm=1,ll
318 : 11913723 : onem=-onem;ylmcst2=ylmcst*sqrt(fact)*sqrt(two)
319 : : ylmgr2_cart(1,1,1)=ylmcst2*((-blm(3,l0+mm)*sphi*sphi+blm(4,l0+mm)*cphi*cphi)*rphase(mm)-&
320 : 11913723 : & blm(5,l0+mm)*2.d0*cphi*sphi*mm*iphase(mm))
321 : : ylmgr2_cart(1,1,2)=ylmcst2*((-blm(3,l0+mm)*sphi*sphi+blm(4,l0+mm)*cphi*cphi)*iphase(mm)+&
322 : 11913723 : & blm(5,l0+mm)*2.d0*cphi*sphi*mm*rphase(mm))
323 : : ylmgr2_cart(2,2,1)=ylmcst2*((-blm(3,l0+mm)*cphi*cphi+blm(4,l0+mm)*sphi*sphi)*rphase(mm)+&
324 : 11913723 : & blm(5,l0+mm)*2.d0*cphi*sphi*mm*iphase(mm))
325 : : ylmgr2_cart(2,2,2)=ylmcst2*((-blm(3,l0+mm)*cphi*cphi+blm(4,l0+mm)*sphi*sphi)*iphase(mm)-&
326 : 11913723 : & blm(5,l0+mm)*2.d0*cphi*sphi*mm*rphase(mm))
327 : 11913723 : ylmgr2_cart(3,3,1)=ylmcst2*blm(1,l0+mm)*rphase(mm)
328 : 11913723 : ylmgr2_cart(3,3,2)=ylmcst2*blm(1,l0+mm)*iphase(mm)
329 : : ylmgr2_cart(3,1,1)=ylmcst2*(blm(2,l0+mm)*cphi*rphase(mm)-&
330 : 11913723 : & mm*iphase(mm)*sphi*onem*plm_dtheta(ll,mm,ctheta))
331 : : ylmgr2_cart(3,1,2)=ylmcst2*(blm(2,l0+mm)*cphi*iphase(mm)+&
332 : 11913723 : & mm*rphase(mm)*sphi*onem*plm_dtheta(ll,mm,ctheta))
333 : : ylmgr2_cart(3,2,1)=ylmcst2*(blm(2,l0+mm)*sphi*rphase(mm)+&
334 : 11913723 : & mm*iphase(mm)*cphi*onem*plm_dtheta(ll,mm,ctheta))
335 : : ylmgr2_cart(3,2,2)=ylmcst2*(blm(2,l0+mm)*sphi*iphase(mm)-&
336 : 11913723 : & mm*rphase(mm)*cphi*onem*plm_dtheta(ll,mm,ctheta))
337 : : ylmgr2_cart(2,1,1)=ylmcst2*((blm(3,l0+mm)+blm(4,l0+mm))*sphi*cphi*rphase(mm)-&
338 : 11913723 : & blm(5,l0+mm)*(sphi*sphi-cphi*cphi)*mm*iphase(mm))
339 : : ylmgr2_cart(2,1,2)=ylmcst2*((blm(3,l0+mm)+blm(4,l0+mm))*sphi*cphi*iphase(mm)+&
340 : 11913723 : & blm(5,l0+mm)*(sphi*sphi-cphi*cphi)*mm*rphase(mm))
341 [ + + ]: 35741169 : ylmgr2_cart(1,3,:)=ylmgr2_cart(3,1,:)
342 [ + + ]: 35741169 : ylmgr2_cart(1,2,:)=ylmgr2_cart(2,1,:)
343 [ + + ]: 35741169 : ylmgr2_cart(2,3,:)=ylmgr2_cart(3,2,:)
344 : : ! 2-Transfer gradients into reduced coordinates
345 [ + + ]: 35741169 : do kk=1,2
346 [ + + ]: 95309784 : do jj=1,3
347 [ + + ]: 309756798 : do ii=1,3
348 : : ylmgr2_tmp(ii,jj)=(rprimd(1,jj)*ylmgr2_cart(1,ii,kk)+&
349 : : & rprimd(2,jj)*ylmgr2_cart(2,ii,kk)+&
350 : 285929352 : & rprimd(3,jj)*ylmgr2_cart(3,ii,kk))
351 : : end do
352 : : end do
353 [ + + ]: 178705845 : do ii=1,6
354 : 142964676 : ia=alpha(ii);ib=beta(ii)
355 : : ylmgr_red(ii,kk)=(rprimd(1,ia)*ylmgr2_tmp(1,ib)+&
356 : : & rprimd(2,ia)*ylmgr2_tmp(2,ib)+&
357 : 166792122 : & rprimd(3,ia)*ylmgr2_tmp(3,ib))
358 : : end do
359 : : end do
360 [ + + ]: 83396061 : ylm_gr(ikg+ipw,4:9,l0+mm) =ylmgr_red(1:6,1)
361 [ + + ]: 83396061 : ylm_gr(ikg+ipw,4:9,l0-mm) =ylmgr_red(1:6,2)
362 [ + + ]: 19718221 : if (mm/=ll) fact=fact/real((ll+mm+1)*(ll-mm),dp)
363 : : end do ! End loop over m
364 : : end do ! End loop over l
365 : : end if
366 : :
367 : : ! End condition r<>0
368 : : end if
369 : :
370 : : ! End loop over k+G
371 : : end do
372 : :
373 : : ! End condition l<>0
374 : : end if
375 : :
376 [ - + ]: 131204 : ABI_FREE(kg_k)
377 : :
378 : 171223 : ikg=ikg+npw_k
379 : : end do ! End Loop over k-points
380 : :
381 : : !Release the temporary memory
382 : : !Allocate some memory
383 [ + + ]: 8717 : if (optder/=0) then
384 [ - + ]: 3744 : ABI_FREE(ylmgr_cart)
385 : : end if
386 [ + + ]: 8717 : if (optder/=0.and.optder/=2) then
387 [ - + ]: 3057 : ABI_FREE(ylmgr_red)
388 : : end if
389 [ + + ]: 8717 : if (optder==2) then
390 [ - + ]: 687 : ABI_FREE(ylmgr2_cart)
391 [ - + ]: 687 : ABI_FREE(ylmgr2_tmp)
392 [ - + ]: 687 : ABI_FREE(ylmgr_red)
393 [ - + ]: 687 : ABI_FREE(blm)
394 : : end if
395 : :
396 [ - + - + : 8717 : end subroutine initylmg
- + - + -
+ ]
397 : : !!***
398 : :
399 : : !!****f* ABINIT/initylmg_k
400 : : !! NAME
401 : : !! initylmg_k
402 : : !!
403 : : !! FUNCTION
404 : : !! Simplified interface to compute Ylm for a single k-point.
405 : : !! See initylmg for the the meaning of the input variables.
406 : : !!
407 : : !! SOURCE
408 : :
409 : 1143 : subroutine initylmg_k(npw_k, mpsang, optder, rprimd, gprimd, kpt, kg_k, ylm_k, ylm_gr_k)
410 : :
411 : : !Arguments ------------------------------------
412 : : !scalars
413 : : integer,intent(in) :: mpsang, npw_k, optder
414 : : !arrays
415 : : real(dp),intent(in) :: kpt(3)
416 : : integer,intent(in) :: kg_k(3,npw_k)
417 : : real(dp),intent(in) :: gprimd(3,3), rprimd(3,3)
418 : : real(dp),intent(out) :: ylm_k(npw_k, mpsang*mpsang)
419 : : real(dp),intent(out) :: ylm_gr_k(npw_k, 3+6*(optder/2), mpsang*mpsang)
420 : :
421 : : !Local variables ------------------------------
422 : : !scalars
423 : : integer,parameter :: nkpt_1 = 1, nsppol_1 = 1
424 : : integer :: npwarr__(nkpt_1), nband__(nkpt_1 * nsppol_1)
425 : : real(dp) :: kptns__(3,nkpt_1)
426 : 1143 : type(MPI_type) :: seq_mpi_enreg
427 : : !*****************************************************************
428 : :
429 : 1143 : call initmpi_seq(seq_mpi_enreg)
430 : 1143 : npwarr__(1) = npw_k
431 : 1143 : kptns__(:,1) = kpt
432 [ + + ]: 2286 : nband__ = 1 ! Not used in sequential
433 : :
434 : : call initylmg(gprimd, kg_k, kptns__, nkpt_1, seq_mpi_enreg, mpsang, npw_k, &
435 : 1143 : nband__, nkpt_1, npwarr__, nsppol_1, optder, rprimd, ylm_k, ylm_gr_k)
436 : :
437 : 1143 : call destroy_mpi_enreg(seq_mpi_enreg)
438 : :
439 [ - + - + : 1143 : end subroutine initylmg_k
- + - + -
+ - + - +
- + - + -
+ - + ]
440 : : !!***
441 : :
442 : : end module m_initylmg
443 : : !!***
|
