Line data Source code
1 : MODULE m_uj2f
2 : USE m_juDFT
3 : ! *********************************************************************
4 : ! * The calculation of slater integrals from u&j *
5 : ! * input in eV; output in htr. *
6 : ! *-------------------------------------------------------------------*
7 : ! * Extension to multiple U per atom type by G.M. 2017 *
8 : ! * Extension for uses beyond LDA+U by H.J 2019 *
9 : ! *********************************************************************
10 : USE m_types
11 :
12 : IMPLICIT NONE
13 :
14 : INTERFACE uj2f
15 : procedure :: uj2f_simple, uj2f_spins, uj2f_single
16 : procedure :: uj2f_single_onelist, uj2f_multiple_onelist
17 : END INTERFACE
18 :
19 : CONTAINS
20 :
21 0 : subroutine uj2f_single_onelist(jspins,u_in,f)
22 :
23 : INTEGER, INTENT(IN) :: jspins
24 : TYPE(t_utype), INTENT(IN) :: u_in
25 : REAL, INTENT(OUT) :: f(0:6)
26 :
27 : real :: f0, f2, f4, f6
28 :
29 0 : f = 0.0
30 0 : CALL uj2f_single(jspins,u_in,f0,f2,f4,f6)
31 0 : f(0) = f0
32 0 : f(2) = f2
33 0 : f(4) = f4
34 0 : f(6) = f6
35 :
36 0 : end subroutine
37 :
38 0 : subroutine uj2f_multiple_onelist(jspins,u_in,n_u,f)
39 :
40 : INTEGER, INTENT(IN) :: jspins
41 : INTEGER, INTENT(IN) :: n_u
42 : TYPE(t_utype), INTENT(IN) :: u_in(:)
43 : REAL, ALLOCATABLE,INTENT(OUT) :: f(:,:)
44 :
45 0 : real :: f0(n_u), f2(n_u), f4(n_u), f6(n_u)
46 :
47 0 : allocate(f(0:6,n_u), source=0.0)
48 :
49 0 : CALL uj2f_simple(jspins,u_in,n_u,f0,f2,f4,f6)
50 :
51 0 : f(0,:) = f0
52 0 : f(2,:) = f2
53 0 : f(4,:) = f4
54 0 : f(6,:) = f6
55 :
56 0 : end subroutine
57 :
58 320 : SUBROUTINE uj2f_single(jspins,u_in,f0,f2,f4,f6)
59 :
60 : INTEGER, INTENT(IN) :: jspins
61 : TYPE(t_utype), INTENT(IN) :: u_in
62 : REAL, INTENT(OUT) :: f0,f2
63 : REAL, INTENT(OUT) :: f4,f6
64 :
65 : REAL :: f0List(1),f2List(1)
66 : REAL :: f4List(1),f6List(1)
67 :
68 640 : CALL uj2f_simple(jspins,[u_in],1,f0List,f2List,f4List,f6List)
69 :
70 320 : f0 = f0List(1)
71 320 : f2 = f2List(1)
72 320 : f4 = f4List(1)
73 320 : f6 = f6List(1)
74 :
75 320 : END SUBROUTINE uj2f_single
76 :
77 320 : SUBROUTINE uj2f_simple(jspins,u_in,n_u,f0,f2,f4,f6)
78 :
79 : INTEGER, INTENT(IN) :: jspins
80 : INTEGER, INTENT(IN) :: n_u
81 : TYPE(t_utype), INTENT(IN) :: u_in(:)
82 : REAL, INTENT(OUT) :: f0(:),f2(:)
83 : REAL, INTENT(OUT) :: f4(:),f6(:)
84 :
85 320 : REAL :: f0Spins(n_u,jspins),f2Spins(n_u,jspins)
86 320 : REAL :: f4Spins(n_u,jspins),f6Spins(n_u,jspins)
87 :
88 320 : CALL uj2f_spins(jspins,u_in,n_u,f0Spins,f2Spins,f4Spins,f6Spins)
89 :
90 640 : f0 = (f0Spins(:,1) + f0Spins(:,jspins))/ 2.0
91 640 : f2 = (f2Spins(:,1) + f2Spins(:,jspins))/ 2.0
92 640 : f4 = (f4Spins(:,1) + f4Spins(:,jspins))/ 2.0
93 640 : f6 = (f6Spins(:,1) + f6Spins(:,jspins))/ 2.0
94 :
95 320 : END SUBROUTINE uj2f_simple
96 :
97 320 : SUBROUTINE uj2f_spins(jspins,u_in,n_u,f0,f2,f4,f6)
98 :
99 : INTEGER, INTENT(IN) :: jspins
100 : INTEGER, INTENT(IN) :: n_u
101 : TYPE(t_utype), INTENT(IN) :: u_in(:)
102 : REAL, INTENT(OUT) :: f0(:,:),f2(:,:)
103 : REAL, INTENT(OUT) :: f4(:,:),f6(:,:)
104 :
105 : INTEGER l,itype,ltest,ispin,i_u
106 : REAL u,j,a,ftest(4)
107 : LOGICAL l_exist
108 :
109 320 : l_exist=.FALSE.
110 320 : INQUIRE (file='slaterf',exist=l_exist)
111 :
112 320 : IF (l_exist) THEN
113 : !
114 : ! --> f's have been calculated in cored ; read from file
115 : !
116 0 : OPEN (45,file='slaterf',form='formatted',status='old')
117 0 : DO ispin = 1, jspins
118 0 : DO i_u = 1, n_u
119 0 : itype = u_in(i_u)%atomType
120 0 : l = u_in(i_u)%l
121 0 : f2(i_u,ispin)=0.0 ; f4(i_u,ispin)=0.0 ; f6(i_u,ispin)=0.0
122 0 : 100 READ (45,'(i3,4f20.10)') ltest,ftest(1:4)
123 0 : IF (ltest.EQ.l) THEN
124 0 : f0(i_u,ispin) = ftest(1)
125 0 : IF (l.GT.0) THEN
126 0 : f2(i_u,ispin) = ftest(2)
127 0 : IF (l.GT.1) THEN
128 0 : f4(i_u,ispin) = ftest(3)
129 0 : IF (l.GT.2) THEN
130 0 : f6(i_u,ispin) = ftest(4)
131 : END IF
132 : END IF
133 : END IF
134 : ELSE
135 : GOTO 100
136 : END IF
137 0 : READ (45,'(i3,4f20.10)') ltest,ftest(1)
138 : ! IF (ltest.EQ.0) THEN
139 : ! f0(n,ispin) = f0(n,ispin) - ftest(1)
140 : ! ENDIF
141 :
142 : ! write(*,*) n,ispin,l,f0(n,ispin),f2(n,ispin),
143 : ! + f4(n,ispin),f6(n,ispin)
144 : END DO ! n_u
145 : ENDDO
146 0 : CLOSE (45)
147 : ELSE
148 : !
149 : ! lda_u%l: orb.mom; lda_u%u,j: in eV
150 : !
151 640 : DO i_u = 1, n_u
152 :
153 320 : itype = u_in(i_u)%atomType
154 320 : l = u_in(i_u)%l
155 320 : u = u_in(i_u)%u
156 320 : j = u_in(i_u)%j
157 : !
158 : ! l.eq.0 : f0 = u (the l=0 and l=1 case approximated g.b.`01)
159 : !
160 320 : IF (l.EQ.0) THEN
161 0 : f0(i_u,1) = u
162 0 : f2(i_u,1) = 0.0
163 0 : f4(i_u,1) = 0.0
164 0 : f6(i_u,1) = 0.0
165 0 : IF (j>0.00001) CALL juDFT_error("lda+u: no magnetic s-states", calledby ="uj2f")
166 : !
167 : ! l == 1 : j = f2 / 5 (from PRL 80,5758 g.b.)
168 : !
169 320 : ELSE IF (l.EQ.1) THEN
170 104 : f0(i_u,1) = u
171 104 : f2(i_u,1) = 5.0*j
172 104 : f4(i_u,1) = 0.0
173 104 : f6(i_u,1) = 0.0
174 : !
175 : ! l.eq.2 : 3d: j=(f2+f4)/14; f4/f2 = 0.625
176 : !
177 216 : ELSE IF (l.EQ.2) THEN
178 : ! PRINT*, 'd-states'
179 192 : f0(i_u,1) = u
180 192 : f2(i_u,1) = 14.0*j/1.625
181 192 : f4(i_u,1) = f2(i_u,1)*0.625
182 192 : f6(i_u,1) = 0.0
183 : !
184 : ! l.eq. 3 : 4f: j=(286f2+195f4+250f6)/6435; f2/f4 = 675/451; f2/f6=2025/1001
185 : !
186 24 : ELSE IF (l.EQ.3) THEN
187 : ! PRINT*, 'f-states'
188 24 : f0(i_u,1) = u
189 24 : a= 286.0 + 195.0*451.0/675.0 + 250.0*1001.0/2025.0
190 24 : f2(i_u,1) = 6435.0*j/a
191 24 : f4(i_u,1) = 451.0/675.0*f2(i_u,1)
192 24 : f6(i_u,1) = 1001.0/2025.0*f2(i_u,1)
193 : ELSE
194 0 : CALL juDFT_error('lda+U is restricted to l<=3 !', calledby="uj2f")
195 : END IF
196 640 : IF (jspins.EQ.2) THEN
197 112 : f0(i_u,jspins) = f0(i_u,1)
198 112 : f2(i_u,jspins) = f2(i_u,1)
199 112 : f4(i_u,jspins) = f4(i_u,1)
200 112 : f6(i_u,jspins) = f6(i_u,1)
201 : ENDIF
202 :
203 : END DO ! n_u
204 : ENDIF
205 :
206 320 : END SUBROUTINE uj2f_spins
207 : END MODULE m_uj2f
|
