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