Line data Source code
1 : !--------------------------------------------------------------------------------
2 : ! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
3 : ! This file is part of FLEUR and available as free software under the conditions
4 : ! of the MIT license as expressed in the LICENSE file in more detail.
5 : !--------------------------------------------------------------------------------
6 :
7 : MODULE m_lhglpts
8 : ! **********************************************************
9 : ! calculates lattice harmonics on the gauss-legendre angular
10 : ! mesh - r.pentcheva Feb'96
11 : ! **********************************************************
12 : CONTAINS
13 166 : SUBROUTINE lhglpts(&
14 : & sphhar,atoms,&
15 166 : & rx,nsp,&
16 : & sym,&
17 166 : & ylh)
18 : !
19 : USE m_ylm
20 : USE m_types_sym
21 : USE m_types_sphhar
22 : USE m_types_atoms
23 :
24 : IMPLICIT NONE
25 :
26 : TYPE(t_sym),INTENT(IN) :: sym
27 : TYPE(t_sphhar),INTENT(IN) :: sphhar
28 : TYPE(t_atoms),INTENT(IN) :: atoms
29 : ! ..
30 : ! .. Scalar Arguments ..
31 : INTEGER, INTENT (IN) :: nsp
32 : ! ..
33 : ! .. Array Arguments ..
34 : REAL, INTENT (IN) :: rx(:,:) !(3,dimension%nspd)
35 : REAL, INTENT (OUT):: ylh(:,0:,:) !(dimension%nspd,0:sphhar%nlhd,sphhar%ntypsd)
36 : ! ..
37 : ! .. Local Scalars ..
38 : REAL s
39 : INTEGER k,lh,mem,nd,ll1,lm
40 : ! ..
41 : ! .. Local Arrays ..
42 166 : COMPLEX ylm( (atoms%lmaxd+1)**2 )
43 : ! ..
44 336 : DO nd = 1,sym%nsymt
45 33332 : DO k = 1,nsp
46 :
47 : CALL ylm4(&
48 : & atoms%lmaxd,rx(:,k),&
49 32996 : & ylm)
50 :
51 1977278 : DO lh = 0,sphhar%nlh(nd)
52 1944112 : s = 0
53 1944112 : ll1 = sphhar%llh(lh,nd) * ( sphhar%llh(lh,nd) + 1 ) + 1
54 5569372 : DO mem = 1,sphhar%nmem(lh,nd)
55 3625260 : lm = ll1 + sphhar%mlh(mem,lh,nd)
56 5569372 : s = s + REAL( sphhar%clnu(mem,lh,nd) * ylm(lm) )
57 : ENDDO
58 1977108 : ylh(k,lh,nd) = s
59 : ENDDO
60 :
61 : ENDDO
62 : ENDDO
63 166 : RETURN
64 : END SUBROUTINE lhglpts
65 : END MODULE m_lhglpts
|