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_nmat
8 : ! ************************************************************
9 : ! This subroutine calculates the density matrix n^{s}_{m,m'}
10 : ! for a given atom 'n' and l-quantum number 'l'. The l's for
11 : ! all atoms are stored in lda_u(), if lda_u()<0, no +U is used.
12 : ! For details see Eq.(12) of Shick et al. PRB 60, 10765 (1999)
13 : ! Part of the LDA+U package G.B., Oct. 2000
14 : ! Extension to multiple U per atom type by G.M. 2017
15 : ! ************************************************************
16 : CONTAINS
17 3276 : SUBROUTINE n_mat(atoms,sym,ne,usdus,jspin,we,eigVecCoeffs,n_mmp)
18 :
19 : USE m_types
20 : USE m_constants
21 : USE m_symMMPmat
22 :
23 : IMPLICIT NONE
24 :
25 : TYPE(t_usdus), INTENT(IN) :: usdus
26 : TYPE(t_sym), INTENT(IN) :: sym
27 : TYPE(t_atoms), INTENT(IN) :: atoms
28 : TYPE(t_eigVecCoeffs),INTENT(IN) :: eigVecCoeffs
29 : INTEGER, INTENT(IN) :: ne,jspin
30 : REAL, INTENT(IN) :: we(:)!(input%neig)
31 : COMPLEX, INTENT(INOUT) :: n_mmp(-lmaxU_const:,-lmaxU_const:,:)
32 :
33 : INTEGER i,l,m,lp,mp,n,natom,i_u,i_denmat
34 : INTEGER ilo,ilop,ll1,lmp,lm
35 : COMPLEX c_0
36 :
37 : COMPLEX n_tmp(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const)
38 : !
39 : ! calculate n_mat:
40 : !PRINT *,'Hello'
41 : !WRITE (*,*) 'Hello'
42 9972 : DO i_u = 1,atoms%n_u+atoms%n_opc
43 6696 : if(i_u>atoms%n_u) then
44 2016 : i_denmat = i_u + atoms%n_hia
45 2016 : n = atoms%lda_opc(i_u-atoms%n_u)%atomType
46 2016 : l = atoms%lda_opc(i_u-atoms%n_u)%l
47 : else
48 4680 : i_denmat = i_u
49 4680 : n = atoms%lda_u(i_u)%atomType
50 4680 : l = atoms%lda_u(i_u)%l
51 : endif
52 :
53 6696 : ll1 = (l+1)*l
54 16668 : DO natom = atoms%firstAtom(n), atoms%firstAtom(n) + atoms%neq(n) - 1
55 6696 : n_tmp = cmplx_0
56 : !
57 : ! prepare n_mat in local frame (in noco-calculations this depends
58 : ! also on alpha(n) and beta(n) )
59 : !
60 39888 : DO m = -l,l
61 33192 : lm = ll1+m
62 205176 : DO mp = -l,l
63 165288 : lmp = ll1+mp
64 165288 : c_0 = cmplx_0
65 2379056 : DO i = 1,ne
66 : c_0 = c_0 + we(i) * ( usdus%ddn(l,n,jspin) *&
67 : conjg(eigVecCoeffs%abcof(i,lmp,1,natom,jspin))*eigVecCoeffs%abcof(i,lm,1,natom,jspin) &
68 2379056 : + conjg(eigVecCoeffs%abcof(i,lmp,0,natom,jspin))*eigVecCoeffs%abcof(i,lm,0,natom,jspin) )
69 : ENDDO
70 198480 : n_tmp(m,mp) = c_0
71 : ENDDO
72 : ENDDO
73 : !
74 : ! add local orbital contribution (if there is one) (untested so far)
75 : !
76 15096 : DO ilo = 1, atoms%nlo(n)
77 15096 : IF (atoms%llo(ilo,n).EQ.l) THEN
78 0 : DO m = -l,l
79 0 : lm = ll1+m
80 0 : DO mp = -l,l
81 0 : lmp = ll1+mp
82 0 : c_0 = cmplx_0
83 0 : DO i = 1,ne
84 : c_0 = c_0 + we(i) * ( usdus%uulon(ilo,n,jspin) * (&
85 : conjg(eigVecCoeffs%abcof(i,lmp,0,natom,jspin))*eigVecCoeffs%ccof(m,i,ilo,natom,jspin) &
86 : + conjg(eigVecCoeffs%ccof(mp,i,ilo,natom,jspin))*eigVecCoeffs%abcof(i,lm,0,natom,jspin) )&
87 : + usdus%dulon(ilo,n,jspin) * (&
88 : conjg(eigVecCoeffs%abcof(i,lmp,1,natom,jspin))*eigVecCoeffs%ccof(m,i,ilo,natom,jspin) &
89 0 : + conjg(eigVecCoeffs%ccof(mp,i,ilo,natom,jspin))*eigVecCoeffs%abcof(i,lm,1,natom,jspin)))
90 : ENDDO
91 0 : DO ilop = 1, atoms%nlo(n)
92 0 : IF (atoms%llo(ilop,n).EQ.l) THEN
93 0 : DO i = 1,ne
94 : c_0 = c_0 + we(i) * usdus%uloulopn(ilo,ilop,n,jspin) *&
95 0 : conjg(eigVecCoeffs%ccof(mp,i,ilop,natom,jspin)) *eigVecCoeffs%ccof(m,i,ilo,natom,jspin)
96 : ENDDO
97 : ENDIF
98 : ENDDO
99 0 : n_tmp(m,mp) = n_tmp(m,mp) + c_0
100 : ENDDO
101 : ENDDO
102 : ENDIF
103 : ENDDO
104 : !
105 : ! n_mmp should be rotated by D_mm' ; compare force_a21
106 : !
107 388368 : n_mmp(:,:,i_denmat) = n_mmp(:,:,i_denmat) + conjg(symMMPmat(n_tmp,sym,natom,l)) * 1.0/atoms%neq(n)
108 : !n_mmp(:,:,i_denmat) = n_mmp(:,:,i_denmat) + conjg(n_tmp) * 1.0/atoms%neq(n)
109 : ENDDO ! sum over equivalent atoms
110 : END DO !loop over u parameters
111 :
112 3276 : END SUBROUTINE n_mat
113 : END MODULE m_nmat
|
