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_umix
8 : !
9 : ! mix the old and new density matrix for the lda+U method
10 : ! gb.2001
11 : ! --------------------------------------------------------
12 : ! Extension to multiple U per atom type by G.M. 2017
13 : USE m_juDFT
14 : USE m_types
15 : USE m_constants
16 : USE m_xmlOutput
17 :
18 : IMPLICIT NONE
19 :
20 : CONTAINS
21 :
22 31 : SUBROUTINE u_mix(input,atoms,noco,n_mmp_in,n_mmp_out)
23 :
24 : TYPE(t_input),INTENT(IN) :: input
25 : TYPE(t_atoms),INTENT(IN) :: atoms
26 : TYPE(t_noco), INTENT(IN) :: noco
27 : COMPLEX, INTENT(IN) :: n_mmp_out(-lmaxU_const:,-lmaxU_const:,:,:)
28 : COMPLEX, INTENT(INOUT) :: n_mmp_in (-lmaxU_const:,-lmaxU_const:,:,:)
29 :
30 :
31 : INTEGER :: mp,m,l,itype,i_u,jsp
32 : REAL :: alpha,spinf,gam,del,uParam,jParam
33 31 : REAL :: zero(atoms%n_u),dist(SIZE(n_mmp_in,4))
34 :
35 : CHARACTER(LEN=20) :: attributes(6)
36 31 : COMPLEX,ALLOCATABLE :: n_mmp(:,:,:,:)
37 :
38 : !
39 : ! check for possible rotation of n_mmp
40 : !
41 : !zero=0.0
42 : !CALL nmat_rot(zero,-atoms%lda_u%theta,-atoms%lda_u%phi,3,atoms%n_u,input%jspins,atoms%lda_u%l,n_mmp_out)
43 :
44 : ! Write out n_mmp_out to out.xml file
45 31 : CALL openXMLElementNoAttributes('ldaUDensityMatrix')
46 80 : DO jsp = 1, SIZE(n_mmp_out,4)
47 192 : DO i_u = 1, atoms%n_u
48 112 : l = atoms%lda_u(i_u)%l
49 112 : itype = atoms%lda_u(i_u)%atomType
50 112 : uParam = atoms%lda_u(i_u)%u
51 112 : jParam = atoms%lda_u(i_u)%j
52 784 : attributes = ''
53 112 : WRITE(attributes(1),'(i0)') jsp
54 112 : WRITE(attributes(2),'(i0)') itype
55 112 : WRITE(attributes(3),'(i0)') i_u
56 112 : WRITE(attributes(4),'(i0)') l
57 112 : WRITE(attributes(5),'(f15.8)') uParam
58 112 : WRITE(attributes(6),'(f15.8)') jParam
59 : CALL writeXMLElementMatrixPoly('densityMatrixFor',&
60 : (/'spin ','atomType','uIndex ','l ','U ','J '/),&
61 833 : attributes,n_mmp_out(-l:l,-l:l,i_u,jsp))
62 : END DO
63 : END DO
64 31 : CALL closeXMLElement('ldaUDensityMatrix')
65 :
66 : ! exit subroutine if density matrix does not exist
67 805 : IF(.NOT.ANY(ABS(n_mmp_in(:,:,1:atoms%n_u,:)).GT.1e-12)) RETURN
68 :
69 : !Calculate distance
70 75 : dist = 0.0
71 105 : DO i_u = 1, atoms%n_u
72 637 : DO m = -lmaxU_const,lmaxU_const
73 4332 : DO mp = -lmaxU_const,lmaxU_const
74 9352 : DO jsp = 1, SIZE(n_mmp_in,4)
75 8820 : dist(jsp) = dist(jsp) + ABS(n_mmp_out(m,mp,i_u,jsp) - n_mmp_in(m,mp,i_u,jsp))
76 : ENDDO
77 : ENDDO
78 : ENDDO
79 : ENDDO
80 : !Write to outfile
81 29 : IF(input%jspins.EQ.1) THEN
82 12 : WRITE (oUnit,'(a,f12.6)') 'n_mmp distance =',dist(1)
83 : ELSE
84 51 : DO jsp = 1, SIZE(n_mmp_in,4)
85 134 : if (jsp > 2 .and. .not.any(noco%l_spinoffd_ldau)) cycle
86 51 : WRITE (oUnit,9000) 'n_mmp distance spin ',jsp,' =',dist(jsp)
87 : 9000 FORMAT(a,I1,a,f12.6)
88 : ENDDO
89 : ENDIF
90 :
91 29 : IF (input%ldauLinMix) THEN
92 :
93 : ! mix here straight with given mixing factors
94 0 : ALLOCATE (n_mmp(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,SIZE(n_mmp_in,dim=3),SIZE(n_mmp_in,dim=4)))
95 0 : n_mmp = cmplx_0
96 :
97 0 : alpha = input%ldauMixParam
98 0 : spinf = input%ldauSpinf
99 :
100 0 : IF (input%jspins.EQ.1) THEN
101 0 : DO i_u = 1, atoms%n_u
102 0 : DO m = -lmaxU_const,lmaxU_const
103 0 : DO mp = -lmaxU_const,lmaxU_const
104 :
105 : n_mmp(m,mp,i_u,1) = alpha * n_mmp_out(m,mp,i_u,1) + &
106 0 : (1.0-alpha) * n_mmp_in (m,mp,i_u,1)
107 :
108 : END DO
109 : END DO
110 : END DO
111 : ELSE
112 0 : gam = 0.5 * alpha * (1.0 + spinf)
113 0 : del = 0.5 * alpha * (1.0 - spinf)
114 0 : DO i_u = 1,atoms%n_u
115 0 : DO m = -lmaxU_const,lmaxU_const
116 0 : DO mp = -lmaxU_const,lmaxU_const
117 :
118 : n_mmp(m,mp,i_u,1) = gam * n_mmp_out(m,mp,i_u,1) + &
119 : (1.0-gam) * n_mmp_in (m,mp,i_u,1) - &
120 : del * n_mmp_out(m,mp,i_u,2) + &
121 0 : del * n_mmp_in (m,mp,i_u,2)
122 :
123 : n_mmp(m,mp,i_u,2) = gam * n_mmp_out(m,mp,i_u,2) + &
124 : (1.0-gam) * n_mmp_in (m,mp,i_u,2) - &
125 : del * n_mmp_out(m,mp,i_u,1) + &
126 0 : del * n_mmp_in (m,mp,i_u,1)
127 0 : IF(noco%l_mperp) THEN
128 : n_mmp(m,mp,i_u,3) = alpha * n_mmp_out(m,mp,i_u,3) + &
129 0 : (1.0-alpha) * n_mmp_in (m,mp,i_u,3)
130 : ENDIF
131 :
132 : END DO
133 : END DO
134 : END DO
135 :
136 : ENDIF
137 0 : n_mmp_in = n_mmp
138 0 : DEALLOCATE(n_mmp)
139 : ENDIF
140 :
141 29 : CALL openXMLElementNoAttributes('ldaUDensityMatrixConvergence')
142 75 : DO jsp = 1, SIZE(dist)
143 170 : if (jsp > 2 .and. .not.any(noco%l_spinoffd_ldau)) cycle
144 322 : attributes = ''
145 46 : WRITE(attributes(1),'(i0)') jsp
146 46 : WRITE(attributes(2),'(f13.6)') dist(jsp)
147 167 : CALL writeXMLElementForm('distance',['spin ','distance'],attributes(:2),reshape([4,8,1,13],[2,2]))
148 : ENDDO
149 29 : CALL closeXMLElement('ldaUDensityMatrixConvergence')
150 :
151 : END SUBROUTINE u_mix
152 : END MODULE m_umix
|