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