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_wann_kptsrotate
8 : use m_judft
9 : c****************************************
10 : c Rotate the wave function.
11 : c Frank Freimuth
12 : c****************************************
13 : contains
14 0 : subroutine wann_kptsrotate(
15 : > natd,nlod,llod,
16 : > ntypd,nlo,llo,invsat,
17 : > l_noco,l_soc,
18 : > ntype,neq,nlotot,
19 : > jspin_in,
20 0 : > oper,nop,mrot,nvd,
21 0 : > nv,shiftkpt,
22 0 : > tau,
23 0 : x bkpt,k1,k2,k3,
24 : x zMat,nsfactor)
25 : USE m_types
26 : use m_inv3
27 : use m_constants,only:pimach
28 : implicit none
29 : integer,intent(in) :: natd
30 : integer,intent(in) :: nlod
31 : integer,intent(in) :: llod
32 : integer,intent(in) :: ntypd
33 : INTEGER, INTENT (IN) :: nlo(ntypd)
34 : integer, intent(in) :: llo(nlod,ntypd)
35 : INTEGER, INTENT (IN) :: invsat(natd)
36 : logical,intent(in) :: l_noco
37 : logical,intent(in) :: l_soc
38 : integer,intent(in) :: ntype
39 : integer,intent(in) :: neq(ntype)
40 : integer,intent(in) :: nlotot
41 : integer,intent(in) :: jspin_in
42 : integer,intent(in) :: oper
43 : integer,intent(in) :: nop
44 : integer,intent(in) :: mrot(3,3,nop)
45 : integer,intent(in) :: nvd,nv(:)
46 : integer,intent(in) :: shiftkpt(3)
47 : real,intent(in) :: tau(3,nop)
48 : real,intent(inout) :: bkpt(3)
49 : integer,intent(inout) :: k1(:,:),k2(:,:),k3(:,:) !nvd,jspd
50 :
51 : TYPE(t_mat), INTENT (INOUT) :: zMat !z(nbasfcn,noccbd) !can be real/complex
52 :
53 : complex,intent(out) :: nsfactor !phase of non-symmorphic ops
54 :
55 : real :: bkrot(3),tpi,arg
56 : integer :: rotmat(3,3),determ,ilo
57 : integer :: j1,j2,j3,k,j,at_ind,invoper
58 : real :: shiftnonsymm(3)
59 : real :: phase
60 : INTEGER :: kvec(2*(2*llod+1),nlod,natd)
61 : integer :: natom,ntyp,lm,m,l,lo,nn,jspin
62 : integer :: absoper,jj,jsp_start,jsp_end
63 : integer :: testmat(3,3)
64 :
65 0 : tpi=2.0*pimach()
66 :
67 0 : absoper=abs(oper)
68 :
69 0 : call inv3(mrot(:,:,absoper),rotmat,determ)
70 0 : shiftnonsymm(:)=matmul(rotmat,tau(:,absoper))
71 :
72 : c testmat=matmul(mrot(:,:,absoper),rotmat)
73 : c print*,testmat
74 : c testmat=matmul(rotmat,mrot(:,:,absoper))
75 : c print*,testmat
76 :
77 0 : IF(.NOT.zMat%l_real) THEN
78 0 : if(oper.lt.0)then
79 0 : zMat%data_c = CONJG(zMat%data_c)
80 0 : shiftnonsymm=-1.0*shiftnonsymm
81 : endif
82 : END IF
83 :
84 0 : if(l_noco) then
85 : jsp_start=1
86 : jsp_end=2
87 : else
88 0 : jsp_start=jspin_in
89 0 : jsp_end=jspin_in
90 : endif
91 :
92 :
93 :
94 0 : do jspin=jsp_start,jsp_end
95 0 : if(.not.(l_noco.and.(jspin.eq.2)))then
96 0 : bkrot(:)=0.0
97 0 : do k=1,3
98 0 : bkrot(:)=bkrot(:)+mrot(k,:,absoper)*bkpt(k)
99 : enddo
100 0 : bkpt(:)=bkrot(:)
101 : endif
102 0 : do j=1,nv(jspin) !rotate reciprocal vector
103 : j1=mrot(1,1,absoper)*k1(j,jspin)+
104 : + mrot(2,1,absoper)*k2(j,jspin)+
105 0 : + mrot(3,1,absoper)*k3(j,jspin)
106 : j2=mrot(1,2,absoper)*k1(j,jspin)+
107 : + mrot(2,2,absoper)*k2(j,jspin)+
108 0 : + mrot(3,2,absoper)*k3(j,jspin)
109 : j3=mrot(1,3,absoper)*k1(j,jspin)+
110 : + mrot(2,3,absoper)*k2(j,jspin)+
111 0 : + mrot(3,3,absoper)*k3(j,jspin)
112 0 : k1(j,jspin)=j1
113 0 : k2(j,jspin)=j2
114 0 : k3(j,jspin)=j3
115 : enddo
116 : enddo !jspin
117 :
118 0 : if(oper.lt.0)then !time-inversion symmetry
119 0 : k1 = -k1
120 0 : k2 = -k2
121 0 : k3 = -k3
122 0 : bkpt = -bkpt
123 : endif
124 :
125 0 : do jspin=jsp_start,jsp_end
126 0 : jj=0
127 0 : if(l_noco.and.(jspin.eq.2))then
128 0 : jj=nv(1)+nlotot
129 : endif
130 0 : do j=1,nv(jspin)
131 : phase = k1(j,jspin) * shiftnonsymm(1)
132 : + + k2(j,jspin) * shiftnonsymm(2)
133 0 : + + k3(j,jspin) * shiftnonsymm(3)
134 0 : phase = tpi*phase
135 0 : phase = cos(phase)
136 0 : IF(zMat%l_real) THEN
137 0 : zMat%data_r(j+jj,:) = phase * zMat%data_r(j+jj,:)
138 : ELSE
139 0 : zMat%data_c(j+jj,:) = phase * zMat%data_c(j+jj,:)
140 : END IF
141 : enddo
142 0 : jj=jj+nv(jspin)
143 0 : do ilo=1,nlotot
144 0 : call judft_error("BUG in wann_kptsrotate:LOs missing")
145 : !j=kveclo(ilo)
146 : phase = k1(j,jspin) * shiftnonsymm(1)
147 : + + k2(j,jspin) * shiftnonsymm(2)
148 0 : + + k3(j,jspin) * shiftnonsymm(3)
149 0 : phase = tpi*phase
150 0 : phase = cos(phase)
151 0 : IF(zMat%l_real) THEN
152 0 : zMat%data_r(jj+ilo,:) = phase * zMat%data_r(jj+ilo,:)
153 : ELSE
154 0 : zMat%data_c(jj+ilo,:) = phase * zMat%data_c(jj+ilo,:)
155 : END IF
156 : enddo
157 : enddo
158 :
159 :
160 0 : bkpt(:) = bkpt(:) - shiftkpt(:)
161 0 : k1(:,:) = k1(:,:) + shiftkpt(1)
162 0 : k2(:,:) = k2(:,:) + shiftkpt(2)
163 0 : k3(:,:) = k3(:,:) + shiftkpt(3)
164 :
165 0 : write(6,*)"in wann_kptsrotate:"
166 0 : write(6,*) "bkpt=",bkpt
167 :
168 : arg = tpi*(
169 : + bkpt(1)*shiftnonsymm(1)+
170 : + bkpt(2)*shiftnonsymm(2)+
171 0 : + bkpt(3)*shiftnonsymm(3) )
172 :
173 0 : nsfactor = cmplx(cos(arg),sin(arg))
174 :
175 :
176 :
177 :
178 0 : end subroutine wann_kptsrotate
179 : end module m_wann_kptsrotate
|
