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_fft4
8 : contains
9 0 : subroutine wann_fft4(
10 : > inputfilename,outputfilename,l_conjugate,
11 0 : > rvecnum,rvec,kpoints,
12 : > jspins_in,nkpts,l_bzsym,film,
13 : > l_soc,band_min,band_max,neigd,
14 : > l_socmmn0,wan90version)
15 :
16 : c*************************************************
17 : c Transform 4-dimensional matrices from
18 : c Bloch representation to Wannier representation.
19 : c
20 : c Frank Freimuth, February 2011
21 : c*************************************************
22 :
23 : use m_constants
24 : use m_wann_read_umatrix
25 :
26 : implicit none
27 : character,intent(in):: inputfilename*(*)
28 : character,intent(in):: outputfilename*(*)
29 : logical,intent(in) :: l_conjugate
30 : integer, intent(in) :: rvecnum
31 : integer, intent(in) :: rvec(:,:)
32 : real, intent(in) :: kpoints(:,:)
33 : integer, intent(in) :: jspins_in
34 : integer, intent(in) :: nkpts
35 : logical,intent (in) :: l_bzsym,l_soc
36 : logical,intent(in) :: film
37 : integer,intent(in) :: band_min(2),band_max(2),neigd
38 : logical, intent(in) :: l_socmmn0
39 : integer, intent(in) :: wan90version
40 :
41 : integer :: ikpt,jspins
42 : integer :: kpts
43 : logical :: l_file
44 : c real :: kpoints(3,nkpts)
45 : integer :: num_wann,num_kpts,num_nnmax,jspin
46 : integer :: kspin,kkspin
47 : integer :: wann_shift,num_wann2
48 : integer :: i,j,k,m,info,r1,r2,r3,dummy1
49 : integer :: dummy2,dummy3,dummy4,dummy5,dummy6
50 : integer :: hopmin,hopmax,counter,m1,m2
51 : integer :: num_bands2
52 : integer,allocatable :: iwork(:)
53 : real,allocatable :: energy(:,:),ei(:)
54 : real,allocatable :: eigw(:,:),rwork(:)
55 : complex,allocatable :: work(:),vec(:,:)
56 0 : complex,allocatable :: u_matrix(:,:,:,:)
57 0 : complex,allocatable :: hwann(:,:,:,:)
58 0 : complex,allocatable :: hreal(:,:,:,:)
59 0 : complex,allocatable :: hsomtx(:,:,:,:)
60 0 : complex,allocatable :: hsomtx2(:,:,:,:)
61 : complex :: fac,eulav,eulav1
62 : real :: tmp_omi,rdotk,tpi,minenerg,maxenerg
63 : real, allocatable :: minieni(:),maxieni(:)
64 : character :: jobz,uplo
65 : integer :: kpt,band,lee,lwork,lrwork,liwork,n,lda
66 : complex :: value(4)
67 : logical :: um_format
68 : logical :: repro_eig
69 : logical :: l_chk,l_proj
70 : logical :: have_disentangled
71 0 : integer,allocatable :: ndimwin(:,:)
72 0 : logical,allocatable :: lwindow(:,:,:)
73 : integer :: chk_unit,nkp,ntmp,ierr
74 : character(len=33) :: header
75 : character(len=20) :: checkpoint
76 : real :: tmp_latt(3,3), tmp_kpt_latt(3,nkpts)
77 : real :: omega_invariant
78 0 : complex,allocatable :: u_matrix_opt(:,:,:,:)
79 : integer :: num_bands
80 : logical :: l_umdat
81 : real,allocatable :: eigval2(:,:)
82 : real,allocatable :: eigval_opt(:,:)
83 : real :: scale,a,b
84 : character(len=2) :: spinspin12(0:2)
85 : character(len=3) :: spin12(2)
86 : character(len=6) :: filename
87 : integer :: jp,mp,kk,ii,jj,dir,rvecind
88 : integer :: spin1,spin2
89 :
90 : data spinspin12/' ','.1' , '.2'/
91 : data spin12/'WF1','WF2'/
92 :
93 0 : call timestart("wann_fft4")
94 0 : tpi=2*pimach()
95 :
96 0 : jspins=jspins_in
97 0 : if(l_soc)jspins=1
98 :
99 0 : write(oUnit,*)"nkpts=",nkpts
100 : c*****************************************************
101 : c get num_bands and num_wann from the proj file
102 : c*****************************************************
103 0 : do j=1,0,-1
104 0 : inquire(file=trim('proj'//spinspin12(j)),exist=l_file)
105 0 : if(l_file)then
106 0 : filename='proj'//spinspin12(j)
107 0 : exit
108 : endif
109 : enddo
110 0 : if(l_file)then
111 0 : open (203,file=trim(filename),status='old')
112 0 : rewind (203)
113 : else
114 0 : stop 'no proj/proj.1/proj.2'
115 : endif
116 0 : read (203,*) num_wann,num_bands
117 0 : close (203)
118 0 : write(oUnit,*)'According to proj there are ',num_bands,' bands'
119 0 : write(oUnit,*)"and ",num_wann," wannier functions."
120 :
121 : c****************************************************************
122 : c read in chk
123 : c****************************************************************
124 0 : num_kpts=nkpts
125 0 : allocate( u_matrix_opt(num_bands,num_wann,nkpts,2) )
126 0 : allocate( u_matrix(num_wann,num_wann,nkpts,2) )
127 0 : allocate( lwindow(num_bands,nkpts,2) )
128 0 : allocate( ndimwin(nkpts,2) )
129 :
130 : ! do jspin=1,jspins !spin loop
131 0 : jspin=1
132 : call wann_read_umatrix2(
133 : > nkpts,num_wann,num_bands,
134 : > um_format,jspins, !jspin,
135 : > wan90version,
136 : < have_disentangled,
137 : < lwindow(:,:,jspin),
138 : < ndimwin(:,jspin),
139 : < u_matrix_opt(:,:,:,jspin),
140 0 : < u_matrix(:,:,:,jspin))
141 0 : num_bands2=num_bands
142 : ! enddo !jspin
143 : ! if(jspins.eq.1)then
144 : ! lwindow(:,:,2) = lwindow(:,:,1)
145 : ! ndimwin(:,2) = ndimwin(:,1)
146 : ! u_matrix_opt(:,:,:,2) = u_matrix_opt(:,:,:,1)
147 : ! u_matrix(:,:,:,2) = u_matrix(:,:,:,1)
148 : ! endif
149 :
150 : c****************************************************
151 : c Read the file "WF1.socspicom".
152 : c****************************************************
153 0 : allocate( hsomtx(num_bands2,num_bands2,3,nkpts) )
154 0 : open(304,file=inputfilename,form='formatted')
155 0 : read(304,*)
156 0 : read(304,*)
157 0 : if(l_conjugate)then
158 0 : do nkp=1,num_kpts
159 0 : do i=1,num_bands2
160 0 : do j=1,num_bands2
161 0 : do dir=1,3
162 0 : read(304,*)dummy1,dummy2,dummy3,dummy4,a,b
163 0 : hsomtx(j,i,dir,nkp)=cmplx(a,-b)
164 : enddo !dir
165 : enddo !j
166 : enddo !i
167 : enddo !nkp
168 : else
169 0 : do nkp=1,num_kpts
170 0 : do i=1,num_bands2
171 0 : do j=1,num_bands2
172 0 : do dir=1,3
173 0 : read(304,*)dummy1,dummy2,dummy3,dummy4,a,b
174 0 : hsomtx(j,i,dir,nkp)=cmplx(a,b)
175 : enddo !dir
176 : enddo !j
177 : enddo !i
178 : enddo !nkp
179 : endif
180 0 : close(304)
181 :
182 : c****************************************************************
183 : c Calculate matrix elements of SOC in the basis of
184 : c rotated Bloch functions.
185 : c****************************************************************
186 0 : allocate( hsomtx2(num_wann,num_wann,3,nkpts) )
187 : write(oUnit,*)"calculate matrix elements of SOC commutator
188 0 : &between wannier orbitals"
189 :
190 0 : if(have_disentangled) then
191 0 : hsomtx2=0.0
192 0 : do nkp=1,num_kpts
193 0 : print*,"nkp=",nkp
194 0 : do dir=1,3
195 :
196 0 : do j=1,num_wann
197 0 : do jp=1,num_wann
198 0 : do m=1,ndimwin(nkp,1)
199 0 : do mp=1,ndimwin(nkp,1)
200 : hsomtx2(jp,j,dir,nkp)=hsomtx2(jp,j,dir,nkp)+
201 : & conjg(u_matrix_opt(mp,jp,nkp,1))*
202 : & hsomtx(mp,m,dir,nkp)*
203 0 : & u_matrix_opt(m,j,nkp,1)
204 : enddo !mp
205 : enddo !m
206 : enddo !jp
207 : enddo !j
208 : enddo !dir
209 : enddo !nkp
210 : else
211 0 : hsomtx2 = hsomtx
212 : end if !have_disentangled
213 :
214 0 : allocate(hwann(num_wann,num_wann,3,num_kpts))
215 0 : hwann=cmplx(0.0,0.0)
216 0 : wann_shift=0
217 0 : do k=1,num_kpts
218 0 : print*,"k=",k
219 0 : do dir=1,3
220 0 : do m=1,num_wann
221 0 : do mp=1,num_wann
222 0 : do i=1,num_wann
223 0 : do j=1,num_wann
224 : hwann(mp,m,dir,k)=hwann(mp,m,dir,k)+
225 : * conjg(u_matrix(j,mp,k,1))*
226 : * hsomtx2(j,i,dir,k)*
227 0 : * u_matrix(i,m,k,1)
228 : enddo !j
229 : enddo !i
230 : enddo !mp
231 : enddo !m
232 : enddo
233 : enddo !k
234 :
235 : c************************************************************
236 : c Calculate matrix elements in real space.
237 : c***********************************************************
238 0 : write(oUnit,*)"calculate SOC-mat in rs"
239 0 : allocate(hreal(num_wann,num_wann,3,rvecnum))
240 0 : hreal=cmplx(0.0,0.0)
241 0 : do rvecind=1,rvecnum
242 0 : do k=1,nkpts
243 : rdotk=tpi*( kpoints(1,k)*rvec(1,rvecind)+
244 : + kpoints(2,k)*rvec(2,rvecind)+
245 0 : + kpoints(3,k)*rvec(3,rvecind) )
246 0 : fac=cmplx(cos(rdotk),-sin(rdotk))
247 0 : do dir=1,3
248 0 : do m2=1,num_wann
249 0 : do m1=1,num_wann
250 : hreal(m1,m2,dir,rvecind)=
251 : & hreal(m1,m2,dir,rvecind)+
252 0 : & fac*hwann(m1,m2,dir,k)
253 : enddo !m1
254 : enddo !m2
255 : enddo !dir
256 : enddo !k
257 : enddo !rvecind
258 0 : hreal=hreal/cmplx(real(nkpts),0.0)
259 :
260 0 : open(321,file=outputfilename,form='formatted')
261 0 : do rvecind=1,rvecnum
262 0 : r3=rvec(3,rvecind)
263 0 : r2=rvec(2,rvecind)
264 0 : r1=rvec(1,rvecind)
265 :
266 0 : do j=1,num_wann
267 0 : do i=1,num_wann
268 0 : do dir=1,3
269 : write(321,'(i3,1x,i3,1x,i3,1x,i3,
270 : & 1x,i3,1x,i3,1x,f20.8,1x,f20.8)')
271 0 : & r1,r2,r3,i,j,dir,
272 0 : & hreal(i,j,dir,rvecind)
273 : enddo !dir
274 : enddo!i
275 : enddo !j
276 :
277 : enddo !rvecnum
278 0 : close(321)
279 :
280 0 : deallocate(lwindow,u_matrix_opt,ndimwin)
281 0 : deallocate(u_matrix,hwann,hreal)
282 :
283 0 : call timestop("wann_fft4")
284 0 : end subroutine wann_fft4
285 : end module m_wann_fft4
|
