1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
|
! Copyright (C) 2007-2008 J. K. Dewhurst, S. Sharma and C. Ambrosch-Draxl.
! This file is distributed under the terms of the GNU General Public License.
! See the file COPYING for license details.
!BOP
! !ROUTINE: getevecfv
! !INTERFACE:
subroutine getevecfv(fext,ikp,vpl,vgpl,evecfv)
! !USES:
use modmain
! !INPUT/OUTPUT PARAMETERS:
! fext : filename extension (in,character(*))
! ikp : p-point vector index (in,integer)
! vpl : p-point vector in lattice coordinates (in,real(3))
! vgpl : G+p-vectors in lattice coordinates (out,real(3,ngkmax,nspnfv))
! evecfv : first-variational eigenvectors (out,complex(nmatmax,nstfv,nspnfv))
! !DESCRIPTION:
! Reads in a first-variational eigenvector from file. If the input $k$-point,
! ${\bf p}$, is not in the reduced set, then the eigenvector of the equivalent
! point is read in and the required rotation/translation operations applied.
!
! !REVISION HISTORY:
! Created Feburary 2007 (JKD)
! Fixed transformation error, October 2007 (JKD, Anton Kozhevnikov)
! Fixed l.o. rotation, June 2010 (A. Kozhevnikov)
!EOP
!BOC
implicit none
! arguments
character(*), intent(in) :: fext
integer, intent(in) :: ikp
real(8), intent(in) :: vpl(3),vgpl(3,ngkmax,nspnfv)
complex(8), intent(out) :: evecfv(nmatmax,nstfv,nspnfv)
! local variables
integer isym,lspl,ilspl
integer jspn,ilo,l,lm,i,j
integer ik,igp,igk,ig
integer is,ia,ja,ias,jas
integer recl,nmatmax_,nstfv_,nspnfv_
real(8) vkl_(3),v(3)
real(8) si(3,3),t1
complex(8) z1
character(256) fname
! automatic arrays
logical done(ngkmax)
! allocatable arrays
complex(8), allocatable :: evecfv_(:,:)
if (ikp.gt.0) then
ik=ikp
else
! find the equivalent k-point number and crystal symmetry element
call findkpt(vpl,isym,ik)
end if
! find the record length
inquire(iolength=recl) vkl_,nmatmax_,nstfv_,nspnfv_,evecfv
fname=trim(scrpath)//'EVECFV'//trim(fext)
!$OMP CRITICAL(u122)
do i=1,2
open(122,file=trim(fname),form='UNFORMATTED',access='DIRECT',recl=recl,err=10)
read(122,rec=ik,err=10) vkl_,nmatmax_,nstfv_,nspnfv_,evecfv
exit
10 continue
if (i.eq.2) then
write(*,*)
write(*,'("Error(getevecfv): unable to read from ",A)') trim(fname)
write(*,*)
stop
end if
close(122)
end do
!$OMP END CRITICAL(u122)
t1=abs(vkl(1,ik)-vkl_(1))+abs(vkl(2,ik)-vkl_(2))+abs(vkl(3,ik)-vkl_(3))
if (t1.gt.epslat) then
write(*,*)
write(*,'("Error(getevecfv): differing vectors for k-point ",I8)') ik
write(*,'(" current : ",3G18.10)') vkl(:,ik)
write(*,'(" EVECFV.OUT : ",3G18.10)') vkl_
write(*,*)
stop
end if
if (nmatmax.ne.nmatmax_) then
write(*,*)
write(*,'("Error(getevecfv): differing nmatmax for k-point ",I8)') ik
write(*,'(" current : ",I8)') nmatmax
write(*,'(" EVECFV.OUT : ",I8)') nmatmax_
write(*,*)
stop
end if
if (nstfv.ne.nstfv_) then
write(*,*)
write(*,'("Error(getevecfv): differing nstfv for k-point ",I8)') ik
write(*,'(" current : ",I8)') nstfv
write(*,'(" EVECFV.OUT : ",I8)') nstfv_
write(*,*)
stop
end if
if (nspnfv.ne.nspnfv_) then
write(*,*)
write(*,'("Error(getevecfv): differing nspnfv for k-point ",I8)') ik
write(*,'(" current : ",I8)') nspnfv
write(*,'(" EVECFV.OUT : ",I8)') nspnfv_
write(*,*)
stop
end if
! if p = k then return
if (ikp.gt.0) return
t1=abs(vpl(1)-vkl(1,ik))+abs(vpl(2)-vkl(2,ik))+abs(vpl(3)-vkl(3,ik))
if (t1.lt.epslat) return
! allocate temporary eigenvector array
allocate(evecfv_(nmatmax,nstfv))
! index to spatial rotation in lattice point group
lspl=lsplsymc(isym)
! the inverse of the spatial symmetry rotates k into p
ilspl=isymlat(lspl)
si(:,:)=dble(symlat(:,:,ilspl))
!-----------------------------------------------!
! translate and rotate APW coefficients !
!-----------------------------------------------!
! loop over the first-variational spins
do jspn=1,nspnfv
if (tv0symc(isym)) then
! translation vector is zero
do igk=1,ngk(jspn,ik)
evecfv_(igk,:)=evecfv(igk,:,jspn)
end do
else
! non-zero translation vector gives a phase factor
v(:)=vtcsymc(:,isym)
do igk=1,ngk(jspn,ik)
ig=igkig(igk,jspn,ik)
t1=-(vgc(1,ig)*v(1)+vgc(2,ig)*v(2)+vgc(3,ig)*v(3))
z1=cmplx(cos(t1),sin(t1),8)
evecfv_(igk,:)=z1*evecfv(igk,:,jspn)
end do
end if
! apply spatial rotation operation (passive transformation)
done(1:ngk(jspn,ik))=.false.
i=1
do igk=1,ngk(jspn,ik)
call r3mtv(si,vgkl(:,igk,jspn,ik),v)
do igp=i,ngk(jspn,ik)
if (done(igp)) cycle
t1=abs(v(1)-vgpl(1,igp,jspn)) &
+abs(v(2)-vgpl(2,igp,jspn)) &
+abs(v(3)-vgpl(3,igp,jspn))
if (t1.lt.epslat) then
evecfv(igp,:,jspn)=evecfv_(igk,:)
done(igp)=.true.
exit
end if
end do
do igp=i,ngk(jspn,ik)
if (.not.done(igp)) then
i=igp
exit
end if
end do
end do
end do
!---------------------------------------------------------!
! translate and rotate local-orbital coefficients !
!---------------------------------------------------------!
if (nlotot.gt.0) then
! rotate k-point by inverse symmetry matrix
call r3mtv(si,vkl(:,ik),v)
! loop over the first-variational spins
do jspn=1,nspnfv
! make a copy of the local-orbital coefficients
do i=ngk(jspn,ik)+1,nmat(jspn,ik)
evecfv_(i,:)=evecfv(i,:,jspn)
end do
do is=1,nspecies
do ia=1,natoms(is)
ias=idxas(ia,is)
! equivalent atom for this symmetry
ja=ieqatom(ia,is,isym)
jas=idxas(ja,is)
! phase factor from translation
t1=-twopi*dot_product(vkl(:,ik),atposl(:,ja,is))
z1=cmplx(cos(t1),sin(t1),8)
t1=twopi*dot_product(v(:),atposl(:,ia,is))
z1=z1*cmplx(cos(t1),sin(t1),8)
! rotate local-orbitals (active transformation)
do ilo=1,nlorb(is)
l=lorbl(ilo,is)
lm=idxlm(l,-l)
i=ngk(jspn,ik)+idxlo(lm,ilo,ias)
j=ngk(jspn,ik)+idxlo(lm,ilo,jas)
call rotzflm(symlatc(:,:,lspl),l,l,lolmmax,nstfv,nmatmax, &
evecfv_(j,1),evecfv(i,1,jspn))
evecfv(i:i+2*l,:,jspn)=z1*evecfv(i:i+2*l,:,jspn)
end do
end do
end do
end do
end if
deallocate(evecfv_)
return
end subroutine
!EOC
|
