Line data Source code
1 : !--------------------------------------------------------------------------------
2 : ! Copyright (c) 2021 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 : MODULE m_types_nococonv
7 : USE m_judft
8 : Use m_constants
9 :
10 : IMPLICIT NONE
11 : PRIVATE
12 : TYPE:: t_nococonv
13 : REAL :: theta = 0.0
14 : REAL :: phi = 0.0
15 : REAL :: qss(3) = [0., 0., 0.]
16 : REAL, ALLOCATABLE :: alph(:)
17 : REAL, ALLOCATABLE :: beta(:)
18 : REAL, ALLOCATABLE :: alphRlx(:)
19 : REAL, ALLOCATABLE :: betaRlx(:)
20 : REAL, ALLOCATABLE :: betaPrev(:)
21 : REAL, ALLOCATABLE :: alphPrev(:)
22 : REAL, ALLOCATABLE :: b_con(:, :)
23 : CONTAINS
24 : procedure:: init => t_nococonv_init
25 : procedure:: init_ss => t_nococonv_initss
26 : !Routines to obtain chi transformation matrix
27 : procedure:: chi_pass
28 : procedure:: chi_explicit
29 : generic :: chi => chi_pass, chi_explicit
30 : generic :: umat => chi_pass, chi_explicit
31 : !Routines to rotate density matrix
32 : procedure:: rotdenmat_mat, rotdenmat_denmat
33 : procedure:: rotdenmat_explicit_mat, rotdenmat_explicit_denmat
34 : generic :: rotdenmat => rotdenmat_mat, rotdenmat_denmat, rotdenmat_explicit_mat, rotdenmat_explicit_denmat
35 : !Functions to get magnetiszation vector from density matrix
36 : procedure :: denmat_to_mag_mat, denmat_to_mag_denmat
37 : generic :: denmat_to_mag => denmat_to_mag_mat, denmat_to_mag_denmat
38 : !function to construct density matrix from magnetisaztion vector
39 : procedure:: mag_to_denmat
40 : !Rotate magnetisation vector
41 : procedure :: rot_magvec_ntype,rot_magvec_explicit
42 : generic :: rot_magvec =>rot_magvec_ntype,rot_magvec_explicit
43 : procedure :: avg_moments
44 : procedure :: mpi_bc => mpi_bc_nococonv
45 : end TYPE
46 : public :: t_nococonv
47 : CONTAINS
48 :
49 706 : SUBROUTINE mpi_bc_nococonv(this,mpi_comm,irank)
50 : USE m_mpi_bc_tool
51 : CLASS(t_nococonv),INTENT(INOUT)::this
52 : INTEGER,INTENT(IN):: mpi_comm
53 : INTEGER,INTENT(IN),OPTIONAL::irank
54 : INTEGER ::rank
55 706 : IF (PRESENT(irank)) THEN
56 0 : rank=irank
57 : ELSE
58 706 : rank=0
59 : END IF
60 :
61 706 : CALL mpi_bc(this%theta,rank,mpi_comm)
62 706 : CALL mpi_bc(this%phi,rank,mpi_comm)
63 706 : CALL mpi_bc(rank,mpi_comm,this%qss)
64 706 : CALL mpi_bc(this%alph,rank,mpi_comm)
65 706 : CALL mpi_bc(this%beta,rank,mpi_comm)
66 706 : CALL mpi_bc(this%alphRlx,rank,mpi_comm)
67 706 : CALL mpi_bc(this%betaRlx,rank,mpi_comm)
68 706 : CALL mpi_bc(this%alphPrev,rank,mpi_comm)
69 706 : CALL mpi_bc(this%betaPrev,rank,mpi_comm)
70 706 : CALL mpi_bc(this%b_con,rank,mpi_comm)
71 :
72 706 : END SUBROUTINE mpi_bc_nococonv
73 :
74 74661 : function chi_pass(nococonv, n)
75 : CLASS(t_nococonv), INTENT(IN) :: nococonv
76 : INTEGER, INTENT(IN) :: n
77 : COMPLEX :: chi_pass(2, 2)
78 522627 : chi_pass = nococonv%chi_explicit(nococonv%alph(n), nococonv%beta(n))
79 : end function
80 :
81 77769 : pure function chi_explicit(nococonv, alpha, beta) result(chi)
82 : class(t_nococonv), intent(in) :: nococonv
83 : REAL, INTENT(IN) :: alpha, beta
84 : COMPLEX :: chi(2, 2)
85 77769 : chi(1, 1) = EXP( ImagUnit*alpha/2)*COS(beta/2)
86 77769 : chi(2, 1) = -EXP( ImagUnit*alpha/2)*SIN(beta/2)
87 77769 : chi(1, 2) = EXP(-ImagUnit*alpha/2)*SIN(beta/2)
88 77769 : chi(2, 2) = EXP(-ImagUnit*alpha/2)*COS(beta/2)
89 1010997 : chi=transpose(conjg(chi))
90 77769 : end function
91 :
92 4230148 : function denmat_to_mag_mat(nococonv, mat) result(mag)
93 : class(t_nococonv), intent(in) :: nococonv
94 : complex, intent(in):: mat(2, 2)
95 : real :: mag(0:3)
96 21150740 : mag = nococonv%denmat_to_mag_denmat(real(mat(1, 1)), real(mat(2, 2)), mat(2, 1))
97 4230148 : end function
98 :
99 328 : function mag_to_denmat(nococonv, mag) result(mat)
100 : class(t_nococonv), intent(in) :: nococonv
101 : complex:: mat(2, 2)
102 : real, intent(in) :: mag(0:3)
103 328 : mat(1, 1) = 0.5*(mag(3) + mag(0))
104 328 : mat(2, 2) = 0.5*(mag(0) - mag(3))
105 328 : mat(2, 1) = cmplx(mag(1), mag(2))*0.5
106 328 : mat(1, 2) = cmplx(mag(1), -mag(2))*0.5
107 328 : end function
108 :
109 4232244 : function denmat_to_mag_denmat(nococonv, r11, r22, r21) result(mag)
110 : class(t_nococonv), intent(in) :: nococonv
111 : real, INTENT(IN) :: r11, r22
112 : complex, intent(in):: r21
113 : real :: mag(0:3)
114 4232244 : mag(0) = r11 + r22
115 4232244 : mag(1) = 2*Real(r21)
116 4232244 : mag(2) = 2*Aimag(r21)
117 4232244 : mag(3) = r11 - r22
118 4232244 : end function
119 :
120 0 : subroutine rot_magvec_ntype(nococonv, n, mag, toGlobal)
121 : CLASS(t_nococonv), INTENT(IN) :: nococonv
122 : INTEGER, INTENT(IN) :: n
123 : REAL, INTENT(INOUT) :: mag(0:3)
124 : LOGICAL, INTENT(IN), OPTIONAL :: toGlobal
125 :
126 : complex :: mat(2, 2)
127 :
128 0 : mat = nococonv%mag_to_denmat(mag)
129 0 : call nococonv%rotdenmat(n, mat, toGlobal)
130 0 : mag = nococonv%denmat_to_mag(mat)
131 0 : end subroutine
132 :
133 328 : subroutine rot_magvec_explicit(nococonv, alpha, beta, mag, toGlobal)
134 : CLASS(t_nococonv), INTENT(IN) :: nococonv
135 : REAL, INTENT(IN) :: alpha,beta
136 : REAL, INTENT(INOUT) :: mag(0:3)
137 : LOGICAL, INTENT(IN), OPTIONAL :: toGlobal
138 :
139 : complex :: mat(2, 2)
140 :
141 2296 : mat = nococonv%mag_to_denmat(mag)
142 328 : call nococonv%rotdenmat(alpha,beta, mat, toGlobal)
143 1640 : mag = nococonv%denmat_to_mag(mat)
144 328 : end subroutine
145 :
146 4229820 : subroutine rotdenmat_mat(nococonv, n, mat, toGlobal)
147 : CLASS(t_nococonv), INTENT(IN) :: nococonv
148 : INTEGER, INTENT(IN) :: n
149 : COMPLEX, INTENT(INOUT) :: mat(2, 2)
150 : LOGICAL, INTENT(IN), OPTIONAL:: toGlobal
151 :
152 : real :: r11, r22
153 4229820 : r11 = real(mat(1, 1)); r22 = real(mat(2, 2))
154 4229820 : call nococonv%rotdenmat_explicit_denmat(nococonv%alph(n), nococonv%beta(n), r11, r22, mat(2, 1), toGlobal)
155 4229820 : mat(1, 1) = r11
156 4229820 : mat(2, 2) = r22
157 4229820 : mat(1, 2) = conjg(mat(2, 1))
158 4229820 : end subroutine
159 :
160 457 : subroutine rotdenmat_denmat(nococonv, n, rho11, rho22, rho21, toGlobal)
161 : CLASS(t_nococonv), INTENT(IN) :: nococonv
162 : INTEGER, INTENT(IN) :: n
163 : REAL, INTENT(INOUT) :: rho11
164 : REAL, INTENT(INOUT) :: rho22
165 : COMPLEX, INTENT(INOUT) :: rho21
166 : LOGICAL, INTENT(IN), OPTIONAL:: toGlobal
167 457 : call nococonv%rotdenmat_explicit_denmat(nococonv%alph(n), nococonv%beta(n), rho11, rho22, rho21, toGlobal)
168 457 : end subroutine
169 :
170 328 : subroutine rotdenmat_explicit_mat(nococonv, alph, beta, mat, toGlobal)
171 : CLASS(t_nococonv), INTENT(IN) :: nococonv
172 : REAL, INTENT(IN) :: alph, beta
173 : COMPLEX, INTENT(INOUT) :: mat(2, 2)
174 : LOGICAL, INTENT(IN), OPTIONAL:: toGlobal
175 : real :: r11, r22
176 328 : r11 = real(mat(1, 1)); r22 = real(mat(2, 2))
177 328 : call nococonv%rotdenmat_explicit_denmat(alph, beta, r11, r22, mat(2, 1), toGlobal)
178 328 : mat(1, 1) = r11
179 328 : mat(2, 2) = r22
180 328 : mat(1, 2) = conjg(mat(2, 1))
181 328 : end subroutine
182 :
183 5518440 : SUBROUTINE rotdenmat_explicit_denmat(nococonv, alph, beta, rho11, rho22, rho21, toGlobal)
184 : use m_constants
185 : IMPLICIT NONE
186 :
187 : CLASS(t_nococonv), INTENT(IN) :: nococonv
188 : REAL, INTENT(IN) :: alph, beta
189 : REAL, INTENT(INOUT) :: rho11
190 : REAL, INTENT(INOUT) :: rho22
191 : COMPLEX, INTENT(INOUT) :: rho21
192 : LOGICAL, INTENT(IN), OPTIONAL:: toGlobal
193 : REAL r11n, r22n
194 : COMPLEX r21n
195 5518440 : if (present(toGlobal)) THEN
196 5518440 : if (toGlobal) THEN
197 5088893 : r11n = 0.5*(1.0 + cos(beta))*rho11 - sin(beta)*real(rho21) + 0.5*(1.0 - cos(beta))*rho22
198 5088893 : r22n = 0.5*(1.0 - cos(beta))*rho11 + sin(beta)*real(rho21) + 0.5*(1.0 + cos(beta))*rho22
199 5088893 : r21n = CMPLX(cos(alph), sin(alph))*(0.5*sin(beta)*(rho11 - rho22) + cos(beta)*real(rho21) + cmplx(0.0, aimag(rho21)))
200 5088893 : rho11 = r11n
201 5088893 : rho22 = r22n
202 5088893 : rho21 = r21n
203 :
204 5088893 : RETURN
205 : end if
206 : end if
207 429547 : r11n = sin(beta)*(cos(alph)*real(rho21) + sin(alph)*AIMAG(rho21)) + (rho11 - rho22)*0.5*(1 + cos(beta)) + rho22
208 429547 : r22n = -sin(beta)*(cos(alph)*real(rho21) + sin(alph)*AIMAG(rho21)) + (rho22 - rho11)*0.5*(1 + cos(beta)) + rho11
209 429547 : r21n = (cos(alph)*real(rho21) + sin(alph)*AIMAG(rho21))*(1 + cos(beta)) - 0.5*sin(beta)*(rho11 - rho22) - cmplx(cos(alph), sin(alph))*conjg(rho21)
210 429547 : rho11 = r11n
211 429547 : rho22 = r22n
212 429547 : rho21 = r21n
213 :
214 : end subroutine
215 :
216 160 : subroutine t_nococonv_init(this, noco)
217 : use m_types_noco
218 : class(t_nococonv), INTENT(OUT):: This
219 : type(t_noco), INTENT(IN) :: noco
220 :
221 160 : this%theta = noco%theta_inp
222 160 : this%phi = noco%phi_inp
223 754 : this%alph = noco%alph_inp
224 754 : this%beta = noco%beta_inp
225 160 : if (noco%l_ss) THEN
226 8 : this%qss = noco%qss_inp
227 : else
228 632 : this%qss = 0.0
229 : end if
230 160 : if (allocated(this%b_con)) deallocate (this%b_con)
231 480 : allocate (this%b_con(2, size(this%alph)))
232 982 : this%b_con = 0.0
233 800 : allocate (this%alphprev(size(this%alph)), this%betaprev(size(this%beta)))
234 :
235 160 : end subroutine
236 :
237 160 : subroutine t_nococonv_initss(nococonv, noco, atoms, qss)
238 : use m_types_noco
239 : use m_types_atoms
240 : use m_constants
241 : CLASS(t_nococonv), INTENT(inout):: nococonv
242 : TYPE(t_noco), INTENT(IN) :: noco
243 : TYPE(t_atoms), INTENT(IN):: atoms
244 : REAL, INTENT(IN), OPTIONAL :: qss(3)
245 :
246 : integer :: na, itype
247 160 : if (noco%l_ss) THEN
248 8 : nococonv%qss = noco%qss_inp
249 2 : if (present(qss)) nococonv%qss = qss
250 : end if
251 : ! Check noco stuff and calculate missing noco parameters
252 160 : IF (noco%l_noco) THEN
253 52 : IF (noco%l_ss) THEN
254 : !---> the angle beta is relative to the spiral in a spin-spiral
255 : !---> calculation, i.e. if beta = 0 for all atoms in the unit cell
256 : !---> that means that the moments are "in line" with the spin-spiral
257 : !---> (beta = qss * taual). note: this means that only atoms within
258 : !---> a plane perpendicular to qss can be equivalent!
259 4 : DO iType = 1, atoms%ntype
260 2 : na = atoms%firstAtom(iType)
261 10 : nococonv%alph(iType) = noco%alph_inp(iType) + tpi_const*dot_product(nococonv%qss, atoms%taual(:, na))
262 : END DO
263 : END IF
264 : ELSE
265 :
266 108 : IF (noco%l_ss) THEN
267 0 : CALL judft_error("l_noco=F and l_ss=T is meaningless.")
268 : END IF
269 : END IF
270 160 : end subroutine
271 :
272 4 : subroutine avg_moments(nococonv, den, atoms, magm, theta, phi)
273 : use m_types_atoms
274 : use m_types_potden
275 : use m_polangle
276 : use m_intgr
277 : class(t_nococonv), intent(in) :: nococonv
278 : class(t_potden), INTENT(IN):: den
279 : type(t_atoms), INTENT(IN) :: atoms
280 : real, INTENT(OUT) :: magm(3, atoms%ntype)
281 : real, INTENT(OUT), OPTIONAL :: theta(atoms%ntype)
282 : real, INTENT(OUT), OPTIONAL :: phi(atoms%ntype)
283 :
284 : integer:: i, j
285 : real:: integral(4)
286 36 : magm = 0.0
287 12 : DO i = 1, atoms%ntype
288 8 : integral = 0.0
289 40 : DO j = 1, size(den%mt, 4)
290 40 : call intgr3(den%mt(:, 0, i, j), atoms%rmsh(:, i), atoms%dx(i), atoms%jri(i), integral(j))
291 : END DO
292 8 : magm(3, i) = (integral(1) - integral(2))*sfp_const
293 8 : if (size(den%mt, 4) > 2) THEN
294 8 : magm(1, i) = -2*integral(3)*sfp_const
295 8 : magm(2, i) = 2*integral(4)*sfp_const
296 : end if
297 12 : if (present(theta)) THEN
298 8 : CALL pol_angle(magm(1, i), magm(2, i), magm(3, i), theta(i), phi(i), .true.)
299 : end if
300 : end do
301 4 : END subroutine
302 :
303 480 : end module
|
