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_socsym
8 : use m_juDFT
9 : !-----------------------------------------------------------------------!
10 : ! tests the compatibility of the symmetry elements with the SQA defined !
11 : ! by theta and phi in case of spin-orbit coupling. gb`02 !
12 : !-----------------------------------------------------------------------!
13 : CONTAINS
14 16 : SUBROUTINE soc_sym(
15 16 : > nop,mrot,theta,phi,amat,
16 16 : < error)
17 :
18 : USE m_constants
19 : USE m_inv3
20 : IMPLICIT NONE
21 :
22 : INTEGER, INTENT (IN) :: nop, mrot(3,3,nop)
23 : REAL, INTENT (IN) :: theta, phi, amat(3,3)
24 : LOGICAL, INTENT (OUT) :: error(nop)
25 :
26 : INTEGER iop
27 : REAL st,ct,sp,cp,stt,ctt,pih,test,nn1n,nn2n
28 : REAL sqa(3),n1(3),n2(3),nn1(3),nn2(3),ssqa(3)
29 : REAL ainv(3,3),rrot(3,3),rrot1(3,3)
30 :
31 16 : pih= 0.5*pimach()
32 16 : CALL inv3(amat,ainv,test)
33 16 : st = sin(theta) ; sp = sin(phi) ; stt = sin(theta + pih)
34 16 : ct = cos(theta) ; cp = cos(phi) ; ctt = cos(theta + pih)
35 : !
36 : ! --> find two vectors n1,n2 normal to the spin-quantizatiopn axis (sqa)
37 : !
38 16 : sqa(1) = st*cp ; n1(1) = stt*cp
39 16 : sqa(2) = st*sp ; n1(2) = stt*sp
40 16 : sqa(3) = ct ; n1(3) = ctt
41 :
42 : CALL cross(sqa,n1,
43 16 : < n2)
44 : !dbg write(*,*) n1
45 : !dbg write(*,*) n2
46 : !
47 : ! --> loop over symmetry elements
48 : !
49 73 : error(:) = .false.
50 73 : DO iop = 1, nop
51 :
52 : ! CALL matmul3(mrot(1,1,iop),ainv,rrot1)
53 2964 : rrot1=matmul(mrot(:,:,iop),ainv)
54 : ! CALL matmul2(amat,rrot1,rrot)
55 2280 : rrot=matmul(amat,rrot1)
56 : !
57 : ! ----> rotate n1 and n2 by symmetry element and form the cross-product
58 : ! of the rotated vectors (nn1,nn2) --> ssqa
59 : !
60 741 : nn1=matmul(rrot,n1)
61 741 : nn2=matmul(rrot,n2)
62 :
63 : CALL cross(nn1,nn2,
64 57 : < ssqa)
65 : !
66 : ! ----> if ssqa is identical with sqa accept this symmetry element
67 : !
68 57 : test = sqa(1)*ssqa(1) + sqa(2)*ssqa(2) + sqa(3)*ssqa(3)
69 16 : IF (abs(test-1.0).GT.0.00001) THEN
70 12 : error(iop) = .true.
71 12 : WRITE (oUnit,100) iop,test
72 : ENDIF
73 : ENDDO
74 : 100 FORMAT ('Symmetry element no.',i3,
75 : + ' incompatible with SQA',f20.10)
76 :
77 51 : IF ( ANY(error(:)) ) THEN
78 : ! CALL juDFT_warn
79 : ! + ("symmetry incompatible with SOC - Spin Quantization Axis"
80 : ! + ,calledby ="soc_sym")
81 : WRITE (oUnit,*)
82 2 : + 'symmetry incompatible with SOC - Spin Quant Axis'
83 : ENDIF
84 16 : END SUBROUTINE soc_sym
85 : !---------------------------------------------------------------
86 73 : SUBROUTINE cross(
87 : > a,b,
88 : < c)
89 :
90 : IMPLICIT NONE
91 : REAL, INTENT (IN) :: a(3),b(3)
92 : REAL, INTENT (OUT) :: c(3)
93 :
94 73 : c(1) = a(2) * b(3) - a(3) * b(2)
95 73 : c(2) = a(3) * b(1) - a(1) * b(3)
96 73 : c(3) = a(1) * b(2) - a(2) * b(1)
97 :
98 0 : END SUBROUTINE cross
99 :
100 : END MODULE m_socsym
101 :
|