1
2! Copyright (C) 2013 J. K. Dewhurst, S. Sharma and E. K. U. Gross.
3! This file is distributed under the terms of the GNU General Public License.
4! See the file COPYING for license details.
5
6pure subroutine dhmllolo(is,ias,ngp,ngpq,ld,dh)
7use modmain
8use modphonon
9implicit none
10! arguments
11integer, intent(in) :: is,ias
12integer, intent(in) :: ngp,ngpq
13integer, intent(in) :: ld
14complex(8), intent(inout) :: dh(ld,*)
15! local variables
16integer ilo,jlo,i,j
17integer l1,l2,l3
18integer lm1,lm2,lm3
19complex(8) z1
20do jlo=1,nlorb(is)
21  l3=lorbl(jlo,is)
22  do lm3=l3**2+1,(l3+1)**2
23    j=ngp+idxlo(lm3,jlo,ias)
24    do ilo=1,nlorb(is)
25      l1=lorbl(ilo,is)
26      do lm1=l1**2+1,(l1+1)**2
27        i=ngpq+idxlo(lm1,ilo,ias)
28        z1=0.d0
29        do l2=0,lmaxo
30          if (mod(l1+l2+l3,2).eq.0) then
31            do lm2=l2**2+1,(l2+1)**2
32              z1=z1+gntyyy(lm2,lm3,lm1)*dhlolo(lm2,jlo,ilo,ias)
33            end do
34          end if
35        end do
36        dh(i,j)=dh(i,j)+z1
37      end do
38    end do
39  end do
40end do
41end subroutine
42
43