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_forcea21lo
8 : CONTAINS
9 256 : SUBROUTINE force_a21_lo(atoms,isp,itype,we,eig,ne,eigVecCoeffs,&
10 128 : aveccof,bveccof,cveccof,tlmplm,usdus,a21)
11 : !--------------------------------------------------------------------------
12 : ! This subroutine calculates the local orbital contribution to A21,
13 : ! which is the combination of the terms A17 and A20 according to the
14 : ! paper of R.Yu et al. (PRB vol.43 no.8 p.64111991).
15 : ! p.kurz nov. 1997
16 : !--------------------------------------------------------------------------
17 :
18 : USE m_types_setup
19 : USE m_types_usdus
20 : USE m_types_tlmplm
21 : USE m_types_cdnval
22 :
23 : IMPLICIT NONE
24 :
25 : TYPE(t_usdus), INTENT(IN) :: usdus
26 : TYPE(t_tlmplm), INTENT(IN) :: tlmplm
27 : TYPE(t_atoms), INTENT(IN) :: atoms
28 : TYPE(t_eigVecCoeffs), INTENT(IN) :: eigVecCoeffs
29 :
30 : INTEGER, INTENT (IN) :: itype, ne, isp
31 :
32 : REAL, INTENT(IN) :: we(ne),eig(:) !(input%neig)
33 : REAL, INTENT(INOUT) :: a21(3,atoms%nat)
34 : COMPLEX, INTENT(IN) :: aveccof(3,ne,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat)
35 : COMPLEX, INTENT(IN) :: bveccof(3,ne,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat)
36 : COMPLEX, INTENT(IN) :: cveccof(3,-atoms%llod:atoms%llod,ne,atoms%nlod,atoms%nat)
37 :
38 : COMPLEX tuulo, tdulo, tuloulo
39 : INTEGER lo, lop, l, lp , mp, lm, lmp, iatom, ie, i, lolop, loplo, m, lo1,s
40 :
41 : !--- ABBREVIATIONS --------------------------------------------------------
42 : ! ccof : coefficient of the local orbital function (u_lo*Y_lm)
43 : ! cveccof : is defined equivalently to aveccof, but with the LO-fct.
44 : ! tuulo,tdulo and tuloulo are the MT hamiltonian matrix elements of the
45 : ! local orbitals with the flapw basisfct. and with themselves.
46 : ! for information on nlo,llo,nlol,lo1l,uulon,dulon, and uloulopn see
47 : ! comments in setlomap.
48 : !--------------------------------------------------------------------------
49 :
50 136 : DO lo = 1,atoms%nlo(itype)
51 8 : lo1=SUM(atoms%nlo(:itype-1))+lo
52 8 : l = atoms%llo(lo,itype)
53 152 : DO m = -l,l
54 16 : lm = l* (l+1) + m
55 160 : DO lp = 0,atoms%lnonsph(itype)
56 144 : s=tlmplm%h_loc2_nonsph(itype)
57 1456 : DO mp = -lp,lp
58 1296 : lmp = lp* (lp+1) + mp
59 6624 : DO iatom = atoms%firstAtom(itype), atoms%firstAtom(itype) + atoms%neq(itype) - 1
60 : ! Check whether the t-matrixelement is 0
61 : ! (indmat.EQ.-9999)
62 :
63 5184 : tuulo = tlmplm%h_LO(lmp,m,lo1,isp,isp)
64 5184 : tdulo = tlmplm%h_LO(lmp+s,m,lo1,isp,isp)
65 :
66 270864 : DO ie = 1,ne
67 1062720 : DO i = 1,3
68 : a21(i,iatom)=a21(i,iatom)+2.0*AIMAG(&
69 : CONJG(eigVecCoeffs%abcof(ie,lmp,0,iatom,isp))*tuulo&
70 : *cveccof(i,m,ie,lo,iatom)&
71 : + CONJG(eigVecCoeffs%abcof(ie,lmp,1,iatom,isp))*tdulo&
72 : *cveccof(i,m,ie,lo,iatom)&
73 : + CONJG(eigVecCoeffs%ccof(m,ie,lo,iatom,isp))&
74 : *conjg(tuulo)*aveccof(i,ie,lmp,iatom)&
75 : + CONJG(eigVecCoeffs%ccof(m,ie,lo,iatom,isp))&
76 : *conjg(tdulo)*bveccof(i,ie,lmp,iatom)&
77 1057536 : )*we(ie)/atoms%neq(itype)
78 : END DO
79 : END DO
80 : END DO
81 : END DO
82 : END DO
83 :
84 48 : DO lop = 1, atoms%nlo(itype)
85 32 : lp = atoms%llo(lop,itype)
86 112 : DO mp = -lp, lp
87 64 : lmp = lp* (lp+1) + mp
88 352 : DO iatom = atoms%firstAtom(itype), atoms%firstAtom(itype) + atoms%neq(itype) - 1
89 256 : tuloulo = tlmplm%tuloulo_newer(m,mp,lo,lop,itype,isp,isp)
90 13376 : DO ie = 1,ne
91 52480 : DO i = 1,3
92 : a21(i,iatom)=a21(i,iatom)+2.0*AIMAG(&
93 : + CONJG(eigVecCoeffs%ccof(m,ie,lo,iatom,isp))&
94 : *tuloulo*cveccof(i,mp,ie,lop,iatom)&
95 52224 : )*we(ie)/atoms%neq(itype)
96 : END DO
97 : END DO
98 : END DO
99 : END DO
100 : END DO
101 :
102 80 : DO iatom = atoms%firstAtom(itype), atoms%firstAtom(itype) + atoms%neq(itype) - 1
103 3344 : DO ie = 1,ne
104 13120 : DO i = 1,3
105 : a21(i,iatom)=a21(i,iatom)-2.0*AIMAG(&
106 : (CONJG(eigVecCoeffs%abcof(ie,lm,0,iatom,isp))*cveccof(i,m,ie,lo,iatom)+&
107 : CONJG(eigVecCoeffs%ccof(m,ie,lo,iatom,isp))*aveccof(i,ie,lm,iatom))*usdus%uulon(lo,itype,isp)+&
108 : (CONJG(eigVecCoeffs%abcof(ie,lm,1,iatom,isp))*cveccof(i,m,ie,lo,iatom)+&
109 : CONJG(eigVecCoeffs%ccof(m,ie,lo,iatom,isp))*bveccof(i,ie,lm,iatom))*&
110 13056 : usdus%dulon(lo,itype,isp))*eig(ie)*we(ie)/atoms%neq(itype)
111 : END DO
112 : END DO
113 : END DO
114 :
115 : ! Consider only the lop with l_lop = l_lo
116 40 : DO lop = atoms%lo1l(l,itype),(atoms%lo1l(l,itype)+atoms%nlol(l,itype)-1)
117 96 : DO iatom = atoms%firstAtom(itype), atoms%firstAtom(itype) + atoms%neq(itype) - 1
118 3344 : DO ie = 1,ne
119 13120 : DO i = 1,3
120 : a21(i,iatom)=a21(i,iatom)-2.0*AIMAG(&
121 : CONJG(eigVecCoeffs%ccof(m,ie,lo,iatom,isp))*&
122 : cveccof(i,m,ie,lop,iatom)*&
123 : usdus%uloulopn(lo,lop,itype,isp))*&
124 13056 : eig(ie)*we(ie)/atoms%neq(itype)
125 :
126 : END DO
127 : END DO
128 : END DO
129 : END DO
130 : END DO! m
131 : END DO ! lo
132 :
133 128 : END SUBROUTINE force_a21_lo
134 : END MODULE m_forcea21lo
|
