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_rotdenmat
8 : use m_juDFT
9 : CONTAINS
10 0 : SUBROUTINE rot_den_mat(alph,beta,rho11,rho22,rho21)
11 : c***********************************************************************
12 : c This subroutine rotates the direction of the magnetization of the
13 : c density matrix by multiplying with the unitary 2x2 spin rotation
14 : c matrix. --> U*rho*U^dagger
15 : c Philipp Kurz 2000-02-03
16 : c new method for improved stability (l_new=t) gb'19
17 : c***********************************************************************
18 :
19 : use m_constants
20 : use m_types_nococonv
21 : IMPLICIT NONE
22 :
23 : C .. Scalar Arguments ..
24 : REAL, INTENT (IN) :: alph,beta
25 : REAL, INTENT (INOUT) :: rho11
26 : REAL, INTENT (INOUT) :: rho22
27 : COMPLEX, INTENT (INOUT) :: rho21
28 : C ..
29 : C .. Local Scalars ..
30 : INTEGER ispin
31 : REAL eps,r11n,r22n
32 : COMPLEX r21n
33 : LOGICAL l_new
34 : C ..
35 : C .. Local Arrays ..
36 : COMPLEX u2(2,2),rho(2,2),rhoh(2,2)
37 : C ..
38 :
39 0 : type(t_nococonv):: nococonv
40 :
41 0 : call nococonv%rotdenmat(alph,beta,rho11,rho22,rho21,.true.)
42 : return
43 : l_new = .true.
44 :
45 : IF (l_new) THEN
46 :
47 : r11n = 0.5*(1.0+cos(beta))*rho11 - sin(beta)*real(rho21) +
48 : + 0.5*(1.0-cos(beta))*rho22
49 : r22n = 0.5*(1.0-cos(beta))*rho11 + sin(beta)*real(rho21) +
50 : + 0.5*(1.0+cos(beta))*rho22
51 : r21n = CMPLX(cos(alph),+sin(alph))*(sin(beta)*(rho11-rho22) +
52 : + 2.0*(cos(beta)*real(rho21)+cmplx(0.0,aimag(rho21))))*0.5
53 :
54 : rho11 = r11n
55 : rho22 = r22n
56 : rho21 = r21n
57 :
58 : ELSE
59 :
60 : eps = 1.0e-10
61 :
62 : c---> set up the unitary 2x2 spin rotation matrix U^(2)
63 : u2(1,1) = exp(-ImagUnit*alph/2)*cos(beta/2)
64 : u2(1,2) = -exp(-ImagUnit*alph/2)*sin(beta/2)
65 : u2(2,1) = exp( ImagUnit*alph/2)*sin(beta/2)
66 : u2(2,2) = exp( ImagUnit*alph/2)*cos(beta/2)
67 :
68 : rho(1,1) = cmplx(rho11,0.0)
69 : rho(2,2) = cmplx(rho22,0.0)
70 : rho(2,1) = rho21
71 : rho(1,2) = conjg(rho21)
72 :
73 : c---> first calculate U*rho
74 : rhoh(1,1) = u2(1,1)*rho(1,1) + u2(1,2)*rho(2,1)
75 : rhoh(1,2) = u2(1,1)*rho(1,2) + u2(1,2)*rho(2,2)
76 : rhoh(2,1) = u2(2,1)*rho(1,1) + u2(2,2)*rho(2,1)
77 : rhoh(2,2) = u2(2,1)*rho(1,2) + u2(2,2)*rho(2,2)
78 : c---> now calculate (U*rho)*U^dagger
79 : rho(1,1) = rhoh(1,1)*conjg(u2(1,1))
80 : + + rhoh(1,2)*conjg(u2(1,2))
81 : rho(1,2) = rhoh(1,1)*conjg(u2(2,1))
82 : + + rhoh(1,2)*conjg(u2(2,2))
83 : rho(2,1) = rhoh(2,1)*conjg(u2(1,1))
84 : + + rhoh(2,2)*conjg(u2(1,2))
85 : rho(2,2) = rhoh(2,1)*conjg(u2(2,1))
86 : + + rhoh(2,2)*conjg(u2(2,2))
87 :
88 : c---> check wether the diagonal elements of the rotated density
89 : c---> are real.
90 : DO ispin = 1,2
91 : IF (aimag(rho(ispin,ispin)).GT.eps) THEN
92 : CALL juDFT_error("rotation of mag. failed",calledby
93 : + ="rot_den_mat",hint=
94 : + 'After the rotation of the density matrix in the '//
95 : + 'muffin-tin sphere one diagonal element of the '//
96 : + '(hermitian) density matrix is not real. That means '//
97 : + 'that the density matrix was probably damaged.')
98 : ENDIF
99 : ENDDO
100 :
101 : rho11 = real(rho(1,1))
102 : rho22 = real(rho(2,2))
103 : rho21 = rho(2,1)
104 :
105 : ENDIF
106 :
107 : END SUBROUTINE rot_den_mat
108 : END MODULE m_rotdenmat
109 :
|
