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_wann_mmk0_sph
8 : c***********************************************************************
9 : c computes the Mmn(K) matrix elements which are the overlaps
10 : c between the Bloch wavefunctions, in the spheres
11 : c a modification of the eparas.F routine, so go there
12 : c and to wannier.F for more information on variables
13 : c Y.Mokrousov 15.6.06
14 : c***********************************************************************
15 : CONTAINS
16 0 : SUBROUTINE wann_mmk0_sph(
17 0 : > llod,noccbd,nlod,natd,ntypd,lmaxd,lmax,lmd,
18 0 : > ntype,neq,nlo,llo,acof,bcof,ccof,
19 0 : > ddn,uulon,dulon,uloulopn,
20 0 : = mmn)
21 : implicit none
22 : c .. scalar arguments ..
23 : integer, intent (in) :: llod,nlod,natd,ntypd,lmaxd,lmd
24 : integer, intent (in) :: ntype,noccbd
25 : c .. array arguments ..
26 : integer, intent (in) :: lmax(:) !(ntypd)
27 : integer, intent (in) :: neq(ntypd)
28 : integer, intent (in) :: nlo(ntypd),llo(nlod,ntypd)
29 : real, intent (in) :: ddn(0:lmaxd,ntypd)
30 : real, intent (in) :: uloulopn(nlod,nlod,ntypd)
31 : real, intent (in) :: uulon(nlod,ntypd),dulon(nlod,ntypd)
32 : complex, intent (in) :: ccof(-llod:llod,noccbd,nlod,natd)
33 : complex, intent (in) :: acof(:,0:,:) !acof(noccbd,0:lmd,natd)
34 : complex, intent (in) :: bcof(:,0:,:) !bcof(noccbd,0:lmd,natd)
35 : complex, intent (inout) :: mmn(:,:)
36 : c .. local scalars ..
37 : integer i,j,l,lo,lop,m,natom,nn,ntyp
38 : integer nt1,nt2,lm,n,ll1
39 : complex suma,sumb
40 : C ..
41 : C .. local arrays ..
42 0 : complex, allocatable :: qlo(:,:,:,:,:)
43 0 : complex, allocatable :: qaclo(:,:,:,:),qbclo(:,:,:,:)
44 : C ..
45 : C .. intrinsic functions ..
46 : intrinsic conjg
47 : allocate (qlo(noccbd,noccbd,nlod,nlod,ntypd),
48 : + qaclo(noccbd,noccbd,nlod,ntypd),
49 0 : + qbclo(noccbd,noccbd,nlod,ntypd) )
50 : c---> performs summations of the overlaps of the wavefunctions
51 0 : do 140 i = 1,noccbd
52 0 : do 145 j = 1,noccbd
53 0 : nt1 = 1
54 0 : do 130 n = 1,ntype
55 0 : nt2 = nt1 + neq(n) - 1
56 0 : do 120 l = 0,lmax(n)
57 0 : suma = cmplx(0.,0.)
58 0 : sumb = cmplx(0.,0.)
59 0 : ll1 = l* (l+1)
60 0 : do 110 m = -l,l
61 0 : lm = ll1 + m
62 0 : do natom = nt1,nt2
63 : suma = suma + acof(i,lm,natom)*
64 0 : + conjg(acof(j,lm,natom))
65 : sumb = sumb + bcof(i,lm,natom)*
66 0 : + conjg(bcof(j,lm,natom))
67 : enddo
68 0 : 110 continue
69 0 : mmn(i,j) = mmn(i,j) + (suma+sumb*ddn(l,n))
70 0 : 120 continue
71 0 : nt1 = nt1 + neq(n)
72 0 : 130 continue
73 0 : 145 continue ! cycle by j-band
74 0 : 140 continue ! cycle by i-band
75 : c---> initialize qlo arrays
76 0 : qlo(:,:,:,:,:) = 0.0
77 0 : qaclo(:,:,:,:) = 0.0
78 0 : qbclo(:,:,:,:) = 0.0
79 : c---> prepare the coefficients
80 0 : natom = 0
81 0 : do ntyp = 1,ntype
82 0 : do nn = 1,neq(ntyp)
83 0 : natom = natom + 1
84 0 : do lo = 1,nlo(ntyp)
85 0 : l = llo(lo,ntyp)
86 0 : ll1 = l* (l+1)
87 0 : do m = -l,l
88 0 : lm = ll1 + m
89 0 : do i = 1,noccbd
90 0 : do j = 1,noccbd
91 : qbclo(i,j,lo,ntyp) = qbclo(i,j,lo,ntyp) +
92 : + bcof(i,lm,natom)*conjg(ccof(m,j,lo,natom)) +
93 0 : + ccof(m,i,lo,natom)*conjg(bcof(j,lm,natom))
94 : qaclo(i,j,lo,ntyp) = qaclo(i,j,lo,ntyp) +
95 : + acof(i,lm,natom)*conjg(ccof(m,j,lo,natom)) +
96 0 : + ccof(m,i,lo,natom)*conjg(acof(j,lm,natom))
97 : enddo
98 : enddo
99 : enddo
100 0 : do lop = 1,nlo(ntyp)
101 0 : if (llo(lop,ntyp).eq.l) then
102 0 : do m = -l,l
103 0 : do i = 1,noccbd
104 0 : do j = 1,noccbd
105 : qlo(i,j,lop,lo,ntyp) = qlo(i,j,lop,lo,ntyp) +
106 : + conjg(ccof(m,j,lop,natom))
107 0 : * *ccof(m,i,lo,natom)
108 : enddo
109 : enddo
110 : enddo
111 : endif
112 : enddo
113 : enddo
114 : enddo
115 : enddo
116 :
117 : c---> perform summation of the coefficients with the integrals
118 : c---> of the radial basis functions
119 0 : do ntyp = 1,ntype
120 0 : do lo = 1,nlo(ntyp)
121 0 : l = llo(lo,ntyp)
122 0 : do i = 1,noccbd
123 0 : do j = 1,noccbd
124 : mmn(i,j)= mmn(i,j) +
125 : + ( qaclo(i,j,lo,ntyp)*uulon(lo,ntyp) +
126 0 : + qbclo(i,j,lo,ntyp)*dulon(lo,ntyp) )
127 : enddo
128 : enddo
129 0 : do lop = 1,nlo(ntyp)
130 0 : if (llo(lop,ntyp).eq.l) then
131 0 : do i = 1,noccbd
132 0 : do j = 1,noccbd
133 : mmn(i,j) = mmn(i,j) +
134 0 : + qlo(i,j,lop,lo,ntyp)*uloulopn(lop,lo,ntyp)
135 : enddo
136 : enddo
137 : endif
138 : enddo
139 : enddo
140 : enddo
141 0 : deallocate ( qlo,qaclo,qbclo )
142 :
143 0 : END SUBROUTINE wann_mmk0_sph
144 : END MODULE m_wann_mmk0_sph
|
