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