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,l_onedimens,
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, only:pimach
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,l_onedimens
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 : tpi=2*pimach()
94 :
95 0 : jspins=jspins_in
96 0 : if(l_soc)jspins=1
97 :
98 0 : write(6,*)"nkpts=",nkpts
99 : c*****************************************************
100 : c get num_bands and num_wann from the proj file
101 : c*****************************************************
102 0 : do j=1,0,-1
103 0 : inquire(file=trim('proj'//spinspin12(j)),exist=l_file)
104 0 : if(l_file)then
105 0 : filename='proj'//spinspin12(j)
106 0 : exit
107 : endif
108 : enddo
109 0 : if(l_file)then
110 0 : open (203,file=trim(filename),status='old')
111 0 : rewind (203)
112 : else
113 0 : stop 'no proj/proj.1/proj.2'
114 : endif
115 0 : read (203,*) num_wann,num_bands
116 0 : close (203)
117 0 : write(6,*)'According to proj there are ',num_bands,' bands'
118 0 : write(6,*)"and ",num_wann," wannier functions."
119 :
120 : c****************************************************************
121 : c read in chk
122 : c****************************************************************
123 0 : num_kpts=nkpts
124 0 : allocate( u_matrix_opt(num_bands,num_wann,nkpts,2) )
125 0 : allocate( u_matrix(num_wann,num_wann,nkpts,2) )
126 0 : allocate( lwindow(num_bands,nkpts,2) )
127 0 : allocate( ndimwin(nkpts,2) )
128 :
129 0 : do jspin=1,jspins !spin loop
130 : call wann_read_umatrix2(
131 : > nkpts,num_wann,num_bands,
132 : > um_format,jspin,wan90version,
133 : < have_disentangled,
134 : < lwindow(:,:,jspin),
135 : < ndimwin(:,jspin),
136 : < u_matrix_opt(:,:,:,jspin),
137 0 : < u_matrix(:,:,:,jspin))
138 0 : num_bands2=num_bands
139 : enddo !jspin
140 0 : if(jspins.eq.1)then
141 0 : lwindow(:,:,2) = lwindow(:,:,1)
142 0 : ndimwin(:,2) = ndimwin(:,1)
143 0 : u_matrix_opt(:,:,:,2) = u_matrix_opt(:,:,:,1)
144 0 : u_matrix(:,:,:,2) = u_matrix(:,:,:,1)
145 : endif
146 :
147 : c****************************************************
148 : c Read the file "WF1.socspicom".
149 : c****************************************************
150 0 : allocate( hsomtx(num_bands2,num_bands2,3,nkpts) )
151 0 : open(304,file=inputfilename,form='formatted')
152 0 : read(304,*)
153 0 : read(304,*)
154 0 : if(l_conjugate)then
155 0 : do nkp=1,num_kpts
156 0 : do i=1,num_bands2
157 0 : do j=1,num_bands2
158 0 : do dir=1,3
159 0 : read(304,*)dummy1,dummy2,dummy3,dummy4,a,b
160 0 : hsomtx(j,i,dir,nkp)=cmplx(a,-b)
161 : enddo !dir
162 : enddo !j
163 : enddo !i
164 : enddo !nkp
165 : else
166 0 : do nkp=1,num_kpts
167 0 : do i=1,num_bands2
168 0 : do j=1,num_bands2
169 0 : do dir=1,3
170 0 : read(304,*)dummy1,dummy2,dummy3,dummy4,a,b
171 0 : hsomtx(j,i,dir,nkp)=cmplx(a,b)
172 : enddo !dir
173 : enddo !j
174 : enddo !i
175 : enddo !nkp
176 : endif
177 0 : close(304)
178 :
179 : c****************************************************************
180 : c Calculate matrix elements of SOC in the basis of
181 : c rotated Bloch functions.
182 : c****************************************************************
183 0 : allocate( hsomtx2(num_wann,num_wann,3,nkpts) )
184 : write(6,*)"calculate matrix elements of SOC commutator
185 0 : &between wannier orbitals"
186 :
187 0 : if(have_disentangled) then
188 0 : hsomtx2=0.0
189 0 : do nkp=1,num_kpts
190 0 : print*,"nkp=",nkp
191 0 : do dir=1,3
192 :
193 0 : do j=1,num_wann
194 0 : do jp=1,num_wann
195 0 : do m=1,ndimwin(nkp,1)
196 0 : do mp=1,ndimwin(nkp,1)
197 : hsomtx2(jp,j,dir,nkp)=hsomtx2(jp,j,dir,nkp)+
198 : & conjg(u_matrix_opt(mp,jp,nkp,1))*
199 : & hsomtx(mp,m,dir,nkp)*
200 0 : & u_matrix_opt(m,j,nkp,1)
201 : enddo !mp
202 : enddo !m
203 : enddo !jp
204 : enddo !j
205 : enddo !dir
206 : enddo !nkp
207 : else
208 0 : hsomtx2 = hsomtx
209 : end if !have_disentangled
210 :
211 0 : allocate(hwann(num_wann,num_wann,3,num_kpts))
212 0 : hwann=cmplx(0.0,0.0)
213 0 : wann_shift=0
214 0 : do k=1,num_kpts
215 0 : print*,"k=",k
216 0 : do dir=1,3
217 0 : do m=1,num_wann
218 0 : do mp=1,num_wann
219 0 : do i=1,num_wann
220 0 : do j=1,num_wann
221 : hwann(mp,m,dir,k)=hwann(mp,m,dir,k)+
222 : * conjg(u_matrix(j,mp,k,1))*
223 : * hsomtx2(j,i,dir,k)*
224 0 : * u_matrix(i,m,k,1)
225 : enddo !j
226 : enddo !i
227 : enddo !mp
228 : enddo !m
229 : enddo
230 : enddo !k
231 :
232 : c************************************************************
233 : c Calculate matrix elements in real space.
234 : c***********************************************************
235 0 : write(6,*)"calculate SOC-mat in rs"
236 0 : allocate(hreal(num_wann,num_wann,3,rvecnum))
237 0 : hreal=cmplx(0.0,0.0)
238 0 : do rvecind=1,rvecnum
239 0 : do k=1,nkpts
240 : rdotk=tpi*( kpoints(1,k)*rvec(1,rvecind)+
241 : + kpoints(2,k)*rvec(2,rvecind)+
242 0 : + kpoints(3,k)*rvec(3,rvecind) )
243 0 : fac=cmplx(cos(rdotk),-sin(rdotk))
244 0 : do dir=1,3
245 0 : do m2=1,num_wann
246 0 : do m1=1,num_wann
247 : hreal(m1,m2,dir,rvecind)=
248 : & hreal(m1,m2,dir,rvecind)+
249 0 : & fac*hwann(m1,m2,dir,k)
250 : enddo !m1
251 : enddo !m2
252 : enddo !dir
253 : enddo !k
254 : enddo !rvecind
255 0 : hreal=hreal/cmplx(real(nkpts),0.0)
256 :
257 0 : open(321,file=outputfilename,form='formatted')
258 0 : do rvecind=1,rvecnum
259 0 : r3=rvec(3,rvecind)
260 0 : r2=rvec(2,rvecind)
261 0 : r1=rvec(1,rvecind)
262 :
263 0 : do j=1,num_wann
264 0 : do i=1,num_wann
265 0 : do dir=1,3
266 : write(321,'(i3,1x,i3,1x,i3,1x,i3,
267 : & 1x,i3,1x,i3,1x,f20.8,1x,f20.8)')
268 0 : & r1,r2,r3,i,j,dir,
269 0 : & hreal(i,j,dir,rvecind)
270 : enddo !dir
271 : enddo!i
272 : enddo !j
273 :
274 : enddo !rvecnum
275 0 : close(321)
276 :
277 0 : deallocate(lwindow,u_matrix_opt,ndimwin)
278 0 : deallocate(u_matrix,hwann,hreal)
279 :
280 0 : end subroutine wann_fft4
281 : end module m_wann_fft4
|
