Line data Source code
1 :
2 : #if defined HAVE_CONFIG_H
3 : #include "config.h"
4 : #endif
5 :
6 : #include "abi_common.h"
7 :
8 : module m_tdep_qpt
9 :
10 : use defs_basis
11 : use m_errors
12 : use m_abicore
13 : use m_xmpi
14 : use m_tdep_dataset, only : atdep_dataset_type, MPI_enreg_type
15 : use m_tdep_latt, only : Lattice_type
16 :
17 : implicit none
18 :
19 : type QptBound_type
20 :
21 : integer :: ihol,center
22 : character (len=5) :: letter
23 : double precision :: x,y,z
24 :
25 : end type QptBound_type
26 :
27 : type Qpoints_type
28 :
29 : integer :: nqpt,qpt_tot,qptbound_tot
30 : integer, allocatable :: lgth_segments(:)
31 : double precision, allocatable :: qpt_red(:,:),qpt_cart(:,:)
32 : double precision, allocatable :: special_red(:,:),special_cart(:,:)
33 : character (len=5), allocatable :: special_qpt(:)
34 :
35 : end type Qpoints_type
36 :
37 : public :: tdep_make_qptpath
38 : public :: tdep_make_specialqpt
39 : public :: tdep_destroy_qpt
40 :
41 : contains
42 :
43 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
44 44 : subroutine tdep_make_specialqpt(Invar,Lattice,MPIdata,Qpt,QptBound)
45 :
46 : integer :: qpt_tot,qptbound_tot
47 : double precision :: zeta,eta,delta,mu,nu,angle_alpha
48 : type(atdep_dataset_type),intent(in) :: Invar
49 : type(QptBound_type), allocatable,intent(out) :: QptBound(:)
50 : type(Lattice_type),intent(in) :: Lattice
51 : type(Qpoints_type),intent(out) :: Qpt
52 : type(MPI_enreg_type), intent(in) :: MPIdata
53 :
54 : ! For bravais(1):
55 : ! The holohedral groups are numbered as follows
56 : ! (see international tables for crystallography (1983), p. 13)
57 : ! iholohedry=1 triclinic 1bar
58 : ! iholohedry=2 monoclinic 2/m
59 : ! iholohedry=3 orthorhombic mmm
60 : ! iholohedry=4 tetragonal 4/mmm
61 : ! iholohedry=5 trigonal 3bar m
62 : ! iholohedry=6 hexagonal 6/mmm
63 : ! iholohedry=7 cubic m3bar m
64 :
65 : ! For bravais(2):
66 : ! Centering
67 : ! center=0 no centering
68 : ! center=-1 body-centered
69 : ! center=-3 face-centered
70 : ! center=1 A-face centered
71 : ! center=2 B-face centered
72 : ! center=3 C-face centered
73 :
74 : ! Define the special Q points IN GENERAL
75 : ! Here we use the definitions of special Q points in reduced coordinates
76 : ! as defined in the article: Setyawan and Curtarolo CMS 49, 299 (2010)
77 44 : if ((Invar%bravais(1).eq.2).and.(Invar%bravais(2).eq.0)) then
78 : !FB qptbound_tot=16
79 1 : qptbound_tot=10
80 1 : angle_alpha=Lattice%angle_alpha
81 1 : eta=(1.-Lattice%acell_unitcell(2)*dcos(angle_alpha*pi/180.d0)/Lattice%acell_unitcell(3))/(2.*dsin(angle_alpha*pi/180.d0)**2)
82 1 : nu = 1./2.-eta*Lattice%acell_unitcell(3)*dcos(angle_alpha*pi/180.d0)/Lattice%acell_unitcell(2)
83 1 : ABI_MALLOC(QptBound,(qptbound_tot))
84 : QptBound(:)=(/ QptBound_type (2, 0,'G ', 0.000, 0.000, 0.000),&
85 : & QptBound_type (2, 0,'A ', 0.500, 0.500, 0.000),&
86 : & QptBound_type (2, 0,'C ', 0.000, 0.500, 0.500),&
87 : & QptBound_type (2, 0,'D ', 0.500, 0.000, 0.500),&
88 : & QptBound_type (2, 0,'D1', 0.500, 0.000,-0.500),&
89 : & QptBound_type (2, 0,'E ', 0.500, 0.500, 0.500),&
90 : !FB& QptBound_type (2, 0,'H ', 0.000, eta , 1-nu ),&
91 : !FB& QptBound_type (2, 0,'H1', 0.000, 1-eta, nu ),&
92 : !FB& QptBound_type (2, 0,'H2', 0.000, eta , -nu ),&
93 : !FB& QptBound_type (2, 0,'M ', 0.500, eta , 1-nu ),&
94 : !FB& QptBound_type (2, 0,'M1', 0.500, 1-eta, nu ),&
95 : !FB& QptBound_type (2, 0,'M2', 0.500, eta , -nu ),&
96 : & QptBound_type (2, 0,'X ', 0.000, 0.500, 0.000),&
97 : & QptBound_type (2, 0,'Y ', 0.000, 0.000, 0.500),&
98 : & QptBound_type (2, 0,'Y1', 0.000, 0.000,-0.500),&
99 11 : & QptBound_type (2, 0,'Z ', 0.500, 0.000, 0.000) /)
100 43 : else if ((Invar%bravais(1).eq.3).and.(Invar%bravais(2).eq.0)) then
101 2 : qptbound_tot=8
102 2 : ABI_MALLOC(QptBound,(qptbound_tot))
103 : QptBound(:)=(/ QptBound_type (3, 0,'G ', 0.000, 0.000, 0.000),&
104 : & QptBound_type (3, 0,'R ', 0.500, 0.500, 0.500),&
105 : & QptBound_type (3, 0,'S ', 0.500, 0.500, 0.000),&
106 : & QptBound_type (3, 0,'T ', 0.000, 0.500, 0.500),&
107 : & QptBound_type (3, 0,'U ', 0.500, 0.000, 0.500),&
108 : & QptBound_type (3, 0,'X ', 0.500, 0.000, 0.000),&
109 : & QptBound_type (3, 0,'Y ', 0.000, 0.500, 0.000),&
110 18 : & QptBound_type (3, 0,'Z ', 0.000, 0.000, 0.500) /)
111 41 : else if ((Invar%bravais(1).eq.3).and.(Invar%bravais(2).eq.-1)) then
112 0 : zeta =(1.d0+Lattice%acell_unitcell(1)**2/Lattice%acell_unitcell(3)**2)/4.d0
113 0 : eta =(1.d0+Lattice%acell_unitcell(2)**2/Lattice%acell_unitcell(3)**2)/4.d0
114 0 : delta=(Lattice%acell_unitcell(2)**2-Lattice%acell_unitcell(1)**2)/(4.d0*Lattice%acell_unitcell(3)**2)
115 0 : mu =(Lattice%acell_unitcell(1)**2+Lattice%acell_unitcell(2)**2)/(4.d0*Lattice%acell_unitcell(3)**2)
116 0 : qptbound_tot=13
117 0 : ABI_MALLOC(QptBound,(qptbound_tot))
118 : QptBound(:)=(/ QptBound_type (3,-1,'G ', 0.000 , 0.000 , 0.000),&
119 : & QptBound_type (3,-1,'L ',-mu , mu , 0.5-delta),&
120 : & QptBound_type (3,-1,'L1', mu ,-mu , 0.5+delta),&
121 : & QptBound_type (3,-1,'L2', 0.5-delta, 0.5+delta,-mu),&
122 : & QptBound_type (3,-1,'R ', 0.000 , 0.500 , 0.000),&
123 : & QptBound_type (3,-1,'S ', 0.500 , 0.000 , 0.000),&
124 : & QptBound_type (3,-1,'T ', 0.000 , 0.000 , 0.500),&
125 : & QptBound_type (3,-1,'W ', 0.250 , 0.250 , 0.250),&
126 : & QptBound_type (3,-1,'X ',-zeta , zeta , zeta ),&
127 : & QptBound_type (3,-1,'X1', zeta , 1-zeta ,-zeta),&
128 : & QptBound_type (3,-1,'Y ', eta ,-eta , eta),&
129 : & QptBound_type (3,-1,'Y1', 1-eta , eta ,-eta),&
130 0 : & QptBound_type (3,-1,'Z ', 0.500 , 0.500 ,-0.500) /)
131 41 : else if ((Invar%bravais(1).eq.3).and.(Invar%bravais(2).eq.3)) then
132 7 : zeta=(1.d0+Lattice%acell_unitcell(1)**2/Lattice%acell_unitcell(2)**2)/4.d0
133 7 : qptbound_tot=13
134 7 : ABI_MALLOC(QptBound,(qptbound_tot))
135 : QptBound(:)=(/ QptBound_type (3, 3,'G ', 0.000, 0.000, 0.000),&
136 : & QptBound_type (3, 3,'Gp', 1.000, 0.000, 0.000),&
137 : & QptBound_type (3, 3,'A ', zeta , zeta , 0.500),&
138 : & QptBound_type (3, 3,'A1',-zeta ,1-zeta, 0.500),&
139 : & QptBound_type (3, 3,'R ', 0.000, 0.500, 0.500),&
140 : & QptBound_type (3, 3,'S ', 0.000, 0.500, 0.000),&
141 : & QptBound_type (3, 3,'T ',-0.500, 0.500, 0.500),&
142 : & QptBound_type (3, 3,'X ', zeta , zeta , 0.000),&
143 : & QptBound_type (3, 3,'X1',-zeta ,1-zeta, 0.000),&
144 : & QptBound_type (3, 3,'Y ',-0.500, 0.500, 0.000),&
145 : & QptBound_type (3, 3,'Yp', 0.500, 0.500, 0.000),&
146 : & QptBound_type (3, 3,'Z ', 0.000, 0.000, 0.500),&
147 98 : & QptBound_type (3, 3,'Zp', 1.000, 0.000, 0.500) /)
148 34 : else if ((Invar%bravais(1).eq.4).and.(Invar%bravais(2).eq.0)) then
149 0 : qptbound_tot=6
150 0 : ABI_MALLOC(QptBound,(qptbound_tot))
151 : QptBound(:)=(/ QptBound_type (4, 0,'G ', 0.000, 0.000, 0.000),&
152 : & QptBound_type (4, 0,'A ', 0.500, 0.500, 0.500),&
153 : & QptBound_type (4, 0,'M ', 0.500, 0.500, 0.000),&
154 : & QptBound_type (4, 0,'R ', 0.000, 0.500, 0.500),&
155 : & QptBound_type (4, 0,'X ', 0.000, 0.500, 0.000),&
156 0 : & QptBound_type (4, 0,'Z ', 0.000, 0.000, 0.500) /)
157 34 : else if ((Invar%bravais(1).eq.4).and.(Invar%bravais(2).eq.-1)) then
158 2 : if (Lattice%acell_unitcell(3).lt.Lattice%acell_unitcell(1)) then
159 2 : qptbound_tot=7
160 2 : eta=(1.d0+Lattice%acell_unitcell(3)**2/Lattice%acell_unitcell(1)**2)/4.d0
161 2 : ABI_MALLOC(QptBound,(qptbound_tot))
162 : QptBound(:)=(/ QptBound_type (4,-1,'G ', 0.000, 0.000, 0.000),&
163 : & QptBound_type (4,-1,'M ',-0.500, 0.500, 0.500),&
164 : & QptBound_type (4,-1,'N ', 0.000, 0.500, 0.500),&
165 : & QptBound_type (4,-1,'P ', 0.250, 0.250, 0.250),&
166 : & QptBound_type (4,-1,'X ', 0.000, 0.000, 0.500),&
167 : & QptBound_type (4,-1,'Z ', eta , eta ,-eta ),&
168 16 : & QptBound_type (4,-1,'Z1',-eta ,1.-eta, eta ) /)
169 : else
170 0 : qptbound_tot=9
171 0 : eta=(1.d0+Lattice%acell_unitcell(1)**2/Lattice%acell_unitcell(3)**2)/4.d0
172 0 : zeta=Lattice%acell_unitcell(1)**2/Lattice%acell_unitcell(3)**2/2.d0
173 0 : ABI_MALLOC(QptBound,(qptbound_tot))
174 : QptBound(:)=(/ QptBound_type (4,-1,'G ', 0.000, 0.000, 0.000),&
175 : & QptBound_type (4,-1,'N ', 0.000, 0.500, 0.000),&
176 : & QptBound_type (4,-1,'P ', 0.250, 0.250, 0.250),&
177 : & QptBound_type (4,-1,'S ',-eta , eta , eta ),&
178 : & QptBound_type (4,-1,'S1', eta ,1.-eta,-eta ),&
179 : & QptBound_type (4,-1,'X ', 0.000, 0.000, 0.500),&
180 : & QptBound_type (4,-1,'Y ',-zeta , zeta , 0.500),&
181 : & QptBound_type (4,-1,'Y1', 0.500, 0.500,-zeta ),&
182 0 : & QptBound_type (4,-1,'Z ', 0.500, 0.500,-0.500) /)
183 : end if
184 32 : else if ((Invar%bravais(1).eq.5).and.(Invar%bravais(2).eq.0)) then
185 3 : qptbound_tot=9
186 3 : angle_alpha=Lattice%angle_alpha
187 3 : eta=(1d0+4*dcos(angle_alpha*pi/180d0))/(2d0+4*dcos(angle_alpha*pi/180d0))
188 3 : nu=3d0/4d0-eta/2d0
189 3 : ABI_MALLOC(QptBound,(qptbound_tot))
190 : QptBound(:)=(/ QptBound_type (5, 0,'G ', 0.000, 0.000, 0.000),&
191 : & QptBound_type (5, 0,'F ', 0.500, 0.500, 0.000),&
192 : & QptBound_type (5, 0,'F1 ', 0.500, 0.000, -0.500),&
193 : & QptBound_type (5, 0,'L ', 0.500, 0.000, 0.000),&
194 : & QptBound_type (5, 0,'Z ', 0.500, 0.500, 0.500),&
195 : & QptBound_type (5, 0,'Q ', 1-nu,nu,0),&
196 : & QptBound_type (5, 0,'X ', nu,0,-nu),&
197 : & QptBound_type (5, 0,'B1 ', 0.500,1-eta,eta-1),&
198 30 : & QptBound_type (5, 0,'B ', eta,0.500, 1-eta) /)
199 29 : else if ((Invar%bravais(1).eq.6).and.(Invar%bravais(2).eq.0)) then
200 4 : qptbound_tot=6
201 4 : ABI_MALLOC(QptBound,(qptbound_tot))
202 : QptBound(:)=(/ QptBound_type (6, 0,'G ', 0.000, 0.000, 0.000),&
203 : & QptBound_type (6, 0,'A ', 0.000, 0.000, 0.500),&
204 : & QptBound_type (6, 0,'H ', 0.333, 0.333, 0.500),&
205 : & QptBound_type (6, 0,'K ', 0.333, 0.333, 0.000),&
206 : & QptBound_type (6, 0,'L ', 0.500, 0.000, 0.500),&
207 28 : & QptBound_type (6, 0,'M ', 0.500, 0.000, 0.000) /)
208 25 : else if ((Invar%bravais(1).eq.7).and.(Invar%bravais(2).eq.0)) then
209 6 : qptbound_tot=8
210 6 : ABI_MALLOC(QptBound,(qptbound_tot))
211 : QptBound(:)=(/ QptBound_type (7, 0,'G ', 0.000, 0.000, 0.000),&
212 : & QptBound_type (7, 0,'M ', 0.500, 0.500, 0.000),&
213 : & QptBound_type (7, 0,'R ', 0.500, 0.500, 0.500),&
214 : & QptBound_type (7, 0,'X ', 0.000, 0.500, 0.000),&
215 : ! For testing purpose only!!!!!!!!
216 : & QptBound_type (7, 0,'A ', 0.000, 1.000, 0.000),&
217 : & QptBound_type (7, 0,'B ', 0.500, 1.000, 0.000),&
218 : & QptBound_type (7, 0,'C ', 1.000, 1.000, 0.000),&
219 54 : & QptBound_type (7, 0,'D ', 0.750, 0.750, 0.000) /)
220 19 : else if ((Invar%bravais(1).eq.7).and.(Invar%bravais(2).eq.-1)) then
221 4 : qptbound_tot=4
222 4 : ABI_MALLOC(QptBound,(qptbound_tot))
223 : QptBound(:)=(/ QptBound_type (7,-1,'G ', 0.000, 0.000, 0.000),&
224 : & QptBound_type (7,-1,'H ', 0.500,-0.500, 0.500),&
225 : & QptBound_type (7,-1,'P ', 0.250, 0.250, 0.250),&
226 20 : & QptBound_type (7,-1,'N ', 0.000, 0.000, 0.500) /)
227 15 : else if ((Invar%bravais(1).eq.7).and.(Invar%bravais(2).eq.-3)) then
228 15 : qptbound_tot=8
229 15 : ABI_MALLOC(QptBound,(qptbound_tot))
230 : QptBound(:)=(/ QptBound_type (7,-3,'G ', 0.000, 0.000, 0.000),&
231 : & QptBound_type (7,-3,'K ', 0.375, 0.375, 0.750),&
232 : & QptBound_type (7,-3,'L ', 0.500, 0.500, 0.500),&
233 : & QptBound_type (7,-3,'U ', 0.625, 0.250, 0.625),&
234 : & QptBound_type (7,-3,'W ', 0.500, 0.250, 0.750),&
235 : & QptBound_type (7,-3,'X ', 0.500, 0.000, 0.500),&
236 : & QptBound_type (7,-3,'M ', 0.500, 0.500, 0.000),&
237 135 : & QptBound_type (7,-3,'Xp', 0.500, 0.500, 1.000) /)
238 : end if
239 44 : Qpt%qptbound_tot=qptbound_tot
240 :
241 : ! Define the special Q points USED IN THE CALCULATIONS
242 : ! Two cases of generation: default (0) or by hand (>=1)
243 44 : if (Invar%bzpath.eq.0) then
244 34 : write(Invar%stdout,*) 'Generate the BZ path using the Q points defined by default'
245 34 : if (MPIdata%iam_master) then
246 34 : write(40,*) 'Generate the BZ path using the Q points defined by default'
247 : end if
248 34 : if ((Invar%bravais(1).eq.2).and.(Invar%bravais(2).eq.0)) then
249 : ! MONO: G-Y-H-C-E-M1-A-X-H1
250 : !FB qpt_tot=9
251 1 : qpt_tot=5
252 1 : ABI_MALLOC(Qpt%special_qpt,(qpt_tot))
253 1 : Qpt%special_qpt(1)="X "
254 1 : Qpt%special_qpt(2)="G "
255 1 : Qpt%special_qpt(3)="Y "
256 1 : Qpt%special_qpt(4)="G "
257 1 : Qpt%special_qpt(5)="Z "
258 : !FB Qpt%special_qpt(1)="G "
259 : !FB Qpt%special_qpt(2)="Y "
260 : !FB Qpt%special_qpt(3)="H "
261 : !FB Qpt%special_qpt(4)="C "
262 : !FB Qpt%special_qpt(5)="E "
263 : !FB Qpt%special_qpt(6)="M1"
264 : !FB Qpt%special_qpt(7)="A "
265 : !FB Qpt%special_qpt(8)="X "
266 : !FB Qpt%special_qpt(9)="H1"
267 33 : else if ((Invar%bravais(1).eq.3).and.(Invar%bravais(2).eq.0)) then
268 : ! ORTH: G-X-S-Y-G-Z
269 2 : qpt_tot=6
270 2 : ABI_MALLOC(Qpt%special_qpt,(qpt_tot))
271 2 : Qpt%special_qpt(1)="G "
272 2 : Qpt%special_qpt(2)="X "
273 2 : Qpt%special_qpt(3)="S "
274 2 : Qpt%special_qpt(4)="Y "
275 2 : Qpt%special_qpt(5)="G "
276 2 : Qpt%special_qpt(6)="Z "
277 31 : else if ((Invar%bravais(1).eq.3).and.(Invar%bravais(2).eq.-1)) then
278 : ! BCO: G-X-L-T-W-R-X1-Z-G-Y-S-W
279 0 : qpt_tot=12
280 0 : ABI_MALLOC(Qpt%special_qpt,(qpt_tot))
281 0 : Qpt%special_qpt(1)="G "
282 0 : Qpt%special_qpt(2)="X "
283 0 : Qpt%special_qpt(3)="L "
284 0 : Qpt%special_qpt(4)="T "
285 0 : Qpt%special_qpt(5)="W "
286 0 : Qpt%special_qpt(6)="R "
287 0 : Qpt%special_qpt(7)="X1"
288 0 : Qpt%special_qpt(8)="Z "
289 0 : Qpt%special_qpt(9)="G "
290 0 : Qpt%special_qpt(10)="Y "
291 0 : Qpt%special_qpt(11)="S "
292 0 : Qpt%special_qpt(12)="W "
293 31 : else if ((Invar%bravais(1).eq.3).and.(Invar%bravais(2).eq.3)) then
294 : ! ORTH-C: G-Yp-Gp-Z
295 7 : qpt_tot=4
296 7 : ABI_MALLOC(Qpt%special_qpt,(qpt_tot))
297 7 : Qpt%special_qpt(1) ="G "
298 7 : Qpt%special_qpt(2) ="Yp"
299 7 : Qpt%special_qpt(3) ="Gp"
300 7 : Qpt%special_qpt(4) ="Zp"
301 24 : else if ((Invar%bravais(1).eq.4).and.(Invar%bravais(2).eq.0)) then
302 : ! TET: G-X-M-G-Z-R-A-Z
303 0 : qpt_tot=8
304 0 : ABI_MALLOC(Qpt%special_qpt,(qpt_tot))
305 0 : Qpt%special_qpt(1) ="G "
306 0 : Qpt%special_qpt(2) ="X "
307 0 : Qpt%special_qpt(3) ="M "
308 0 : Qpt%special_qpt(4) ="G "
309 0 : Qpt%special_qpt(5) ="Z "
310 0 : Qpt%special_qpt(6) ="R "
311 0 : Qpt%special_qpt(7) ="A "
312 0 : Qpt%special_qpt(8) ="Z "
313 24 : else if ((Invar%bravais(1).eq.4).and.(Invar%bravais(2).eq.-1)) then
314 2 : if (Lattice%acell_unitcell(3).lt.Lattice%acell_unitcell(1)) then
315 : ! BCT1: G-X-M-G-Z-P-N-Z1-M
316 2 : qpt_tot=9
317 2 : ABI_MALLOC(Qpt%special_qpt,(qpt_tot))
318 2 : Qpt%special_qpt(1) ="G "
319 2 : Qpt%special_qpt(2) ="X "
320 2 : Qpt%special_qpt(3) ="M "
321 2 : Qpt%special_qpt(4) ="G "
322 2 : Qpt%special_qpt(5) ="Z "
323 2 : Qpt%special_qpt(6) ="P "
324 2 : Qpt%special_qpt(7) ="N "
325 2 : Qpt%special_qpt(8) ="Z1"
326 2 : Qpt%special_qpt(9) ="M "
327 : else
328 : ! BCT2: G-X-Y-S-G-Z-S1-N-P-Y1-Z
329 0 : qpt_tot=11
330 0 : ABI_MALLOC(Qpt%special_qpt,(qpt_tot))
331 0 : Qpt%special_qpt(1) ="G "
332 0 : Qpt%special_qpt(2) ="X "
333 0 : Qpt%special_qpt(3) ="Y "
334 0 : Qpt%special_qpt(4) ="S "
335 0 : Qpt%special_qpt(5) ="G "
336 0 : Qpt%special_qpt(6) ="Z "
337 0 : Qpt%special_qpt(7) ="S1"
338 0 : Qpt%special_qpt(8) ="N "
339 0 : Qpt%special_qpt(9) ="P "
340 0 : Qpt%special_qpt(10)="Y1"
341 0 : Qpt%special_qpt(11)="Z "
342 : end if
343 22 : else if ((Invar%bravais(1).eq.5).and.(Invar%bravais(2).eq.0)) then
344 : ! RHOMBO:F1-Q-G-Z-B-B1-L-G-F
345 3 : qpt_tot=9
346 3 : ABI_MALLOC(Qpt%special_qpt,(qpt_tot))
347 3 : Qpt%special_qpt(1)="F1"
348 3 : Qpt%special_qpt(2)="X"
349 3 : Qpt%special_qpt(3)="G "
350 3 : Qpt%special_qpt(4)="Z "
351 3 : Qpt%special_qpt(5)="B "
352 3 : Qpt%special_qpt(6)="B1 "
353 3 : Qpt%special_qpt(7)="L "
354 3 : Qpt%special_qpt(8)="G "
355 3 : Qpt%special_qpt(9)="F "
356 19 : else if ((Invar%bravais(1).eq.6).and.(Invar%bravais(2).eq.0)) then
357 : ! HEX: G-M-K-G-A-L-H-A
358 3 : qpt_tot=8
359 3 : ABI_MALLOC(Qpt%special_qpt,(qpt_tot))
360 3 : Qpt%special_qpt(1)="G "
361 3 : Qpt%special_qpt(2)="M "
362 3 : Qpt%special_qpt(3)="K "
363 3 : Qpt%special_qpt(4)="G "
364 3 : Qpt%special_qpt(5)="A "
365 3 : Qpt%special_qpt(6)="L "
366 3 : Qpt%special_qpt(7)="H "
367 3 : Qpt%special_qpt(8)="A "
368 16 : else if ((Invar%bravais(1).eq.7).and.(Invar%bravais(2).eq.0)) then
369 : ! SC: G-X-M-G-R
370 2 : qpt_tot=5
371 2 : ABI_MALLOC(Qpt%special_qpt,(qpt_tot))
372 2 : Qpt%special_qpt(1)="G "
373 2 : Qpt%special_qpt(2)="X "
374 2 : Qpt%special_qpt(3)="M "
375 2 : Qpt%special_qpt(4)="G "
376 2 : Qpt%special_qpt(5)="R "
377 14 : else if ((Invar%bravais(1).eq.7).and.(Invar%bravais(2).eq.-1)) then
378 : ! BCC: G-P-H-G-N
379 3 : qpt_tot=5
380 3 : ABI_MALLOC(Qpt%special_qpt,(qpt_tot))
381 3 : Qpt%special_qpt(1)="G "
382 3 : Qpt%special_qpt(2)="P "
383 3 : Qpt%special_qpt(3)="H "
384 3 : Qpt%special_qpt(4)="G "
385 3 : Qpt%special_qpt(5)="N "
386 11 : else if ((Invar%bravais(1).eq.7).and.(Invar%bravais(2).eq.-3)) then
387 : ! FCC: G-X-W-Xp-K-G-L
388 11 : qpt_tot=7
389 11 : ABI_MALLOC(Qpt%special_qpt,(qpt_tot))
390 11 : Qpt%special_qpt(1)="G "
391 11 : Qpt%special_qpt(2)="X "
392 11 : Qpt%special_qpt(3)="W "
393 11 : Qpt%special_qpt(4)="Xp"
394 11 : Qpt%special_qpt(5)="K "
395 11 : Qpt%special_qpt(6)="G "
396 11 : Qpt%special_qpt(7)="L "
397 : end if
398 10 : else if (Invar%bzpath.ge.1) then
399 10 : write(Invar%stdout,*) 'Generate the BZ path using the Q points given in the input file'
400 10 : if (MPIdata%iam_master) then
401 10 : write(40,*) 'Generate the BZ path using the Q points given in the input file'
402 : end if
403 10 : qpt_tot=Invar%bzpath
404 30 : ABI_MALLOC(Qpt%special_qpt,(qpt_tot))
405 64 : Qpt%special_qpt(:)=Invar%special_qpt(:)
406 : end if
407 44 : Qpt%qpt_tot=qpt_tot
408 :
409 44 : end subroutine tdep_make_specialqpt
410 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
411 44 : subroutine tdep_make_qptpath(Invar,Lattice,MPIdata,Qpt)
412 :
413 : integer :: ii,jj,kk,nqpt,iqpt,qpt_tot,tmp_int
414 : logical :: IsThisAllowed
415 : type(atdep_dataset_type),intent(in) :: Invar
416 : type(Lattice_type),intent(in) :: Lattice
417 : type(Qpoints_type),intent(out) :: Qpt
418 : type(MPI_enreg_type), intent(in) :: MPIdata
419 44 : type(QptBound_type), allocatable :: QptBound(:)
420 :
421 44 : nqpt=0
422 44 : if (MPIdata%iam_master) open(unit=40,file=trim(Invar%output_prefix)//'_qpt.dat')
423 44 : write(Invar%stdout,*) ' '
424 44 : write(Invar%stdout,*) '#############################################################################'
425 44 : write(Invar%stdout,*) '########################## Q points generation #############################'
426 44 : write(Invar%stdout,*) '#############################################################################'
427 : ! Define the special Q points
428 44 : call tdep_make_specialqpt(Invar,Lattice,MPIdata,Qpt,QptBound)
429 :
430 : ! Define the path in the BZ
431 : ! Two cases of generation: default (0) or by hand (>=1)
432 44 : qpt_tot =Qpt%qpt_tot
433 1074 : ABI_MALLOC(Qpt%special_red ,(qpt_tot,3)); Qpt%special_red (:,:)=zero
434 1030 : ABI_MALLOC(Qpt%special_cart,(qpt_tot,3)); Qpt%special_cart(:,:)=zero
435 :
436 44 : if (Invar%bzpath.ge.0) then
437 : ! If "by hand", verify that the Letter defining the Qpt bound is allowed for this
438 : ! crystallographic group
439 314 : do jj=1,qpt_tot
440 270 : IsThisAllowed=.false.
441 2453 : do ii=1,Qpt%qptbound_tot
442 2453 : if ((QptBound(ii)%ihol.eq.Invar%bravais(1)).and.(QptBound(ii)%center.eq.Invar%bravais(2))) then
443 2183 : if (QptBound(ii)%letter.eq.Qpt%special_qpt(jj)) then
444 270 : IsThisAllowed=.true.
445 270 : Qpt%special_red(jj,1)=QptBound(ii)%x
446 270 : Qpt%special_red(jj,2)=QptBound(ii)%y
447 270 : Qpt%special_red(jj,3)=QptBound(ii)%z
448 : end if
449 : end if
450 : end do
451 314 : if (.not.IsThisAllowed) then
452 0 : ABI_ERROR('One of the Qpt bound (letter) is not allowed.')
453 : end if
454 : end do
455 : ! Compute the cartesian coordinates of the special Q points in the reciprocical lattice
456 314 : do ii=1,qpt_tot
457 1124 : do jj=1,3
458 3510 : do kk=1,3
459 3240 : if (Lattice%line==2) then
460 414 : Qpt%special_cart(ii,jj)=Qpt%special_cart(ii,jj)+Lattice%gprimt(kk,jj)*Qpt%special_red(ii,kk)/Lattice%acell_unitcell(jj)
461 2016 : else if (Lattice%line==0.or.Lattice%line==1) then
462 2016 : Qpt%special_cart(ii,jj)=Qpt%special_cart(ii,jj)+Lattice%gprimt(kk,jj)*Qpt%special_red(ii,kk)/Lattice%acell_unitcell(kk)
463 : end if
464 : end do
465 : end do
466 : end do
467 :
468 44 : if (qpt_tot.gt.1) then
469 358 : ABI_MALLOC(Qpt%lgth_segments,(qpt_tot-1)); Qpt%lgth_segments(:)=0
470 270 : do ii=1,qpt_tot-1
471 : Qpt%lgth_segments(ii)=nint(dsqrt((Qpt%special_cart(ii,1)-Qpt%special_cart(ii+1,1))**2+&
472 : & (Qpt%special_cart(ii,2)-Qpt%special_cart(ii+1,2))**2+&
473 270 : & (Qpt%special_cart(ii,3)-Qpt%special_cart(ii+1,3))**2)*100*2*pi)
474 : end do
475 :
476 44 : tmp_int=Qpt%lgth_segments(1)
477 270 : do ii=1,qpt_tot-1
478 270 : if (Invar%bzlength.eq.0) then
479 216 : Qpt%lgth_segments(ii)=nint(real(Qpt%lgth_segments(ii)*100)/real(tmp_int))
480 10 : else if (Invar%bzlength.gt.0) then
481 10 : Qpt%lgth_segments(ii)=Invar%lgth_segments(ii)
482 : else if (Invar%bzlength.lt.0) then
483 0 : Qpt%lgth_segments(ii)=0
484 : end if
485 : end do
486 :
487 : ! Allocate and define the qpt points along the segments
488 270 : do ii=1,qpt_tot-1
489 270 : nqpt=nqpt+Qpt%lgth_segments(ii)
490 : end do
491 44 : nqpt=nqpt+1
492 90484 : ABI_MALLOC(Qpt%qpt_red ,(3,nqpt)); Qpt%qpt_red (:,:)=zero
493 90440 : ABI_MALLOC(Qpt%qpt_cart,(3,nqpt)); Qpt%qpt_cart(:,:)=zero
494 44 : iqpt=0
495 270 : do ii=1,qpt_tot-1
496 226 : if (Qpt%lgth_segments(ii).eq.0) cycle
497 22814 : do jj=1,Qpt%lgth_segments(ii)
498 22544 : iqpt=iqpt+1
499 : Qpt%qpt_red (:,iqpt)=((jj-1)*Qpt%special_red (ii+1,:)+(Qpt%lgth_segments(ii)-jj+1)*Qpt%special_red (ii,:))&
500 90176 : & /Qpt%lgth_segments(ii)
501 : Qpt%qpt_cart(:,iqpt)=((jj-1)*Qpt%special_cart(ii+1,:)+(Qpt%lgth_segments(ii)-jj+1)*Qpt%special_cart(ii,:))&
502 90402 : & /Qpt%lgth_segments(ii)
503 : end do
504 : end do
505 176 : Qpt%qpt_red (:,nqpt)=Qpt%special_red (qpt_tot,:)
506 176 : Qpt%qpt_cart(:,nqpt)=Qpt%special_cart(qpt_tot,:)
507 0 : else if (qpt_tot.eq.1) then
508 0 : nqpt=1
509 0 : ABI_MALLOC(Qpt%qpt_red ,(3,nqpt)); Qpt%qpt_red (:,:)=zero
510 0 : ABI_MALLOC(Qpt%qpt_cart,(3,nqpt)); Qpt%qpt_cart(:,:)=zero
511 0 : Qpt%qpt_red (:,1)=Qpt%special_red (1,:)
512 0 : Qpt%qpt_cart(:,1)=Qpt%special_cart(1,:)
513 : end if !qpt_tot.gt.1
514 44 : if (MPIdata%iam_master) then
515 44 : write(40,*) ' In reduced coordinates:'
516 314 : do ii=1,qpt_tot
517 314 : write(40,'(a,1x,3(f10.5,1x))') Qpt%special_qpt(ii),Qpt%special_red(ii,1),Qpt%special_red(ii,2),Qpt%special_red(ii,3)
518 : end do
519 44 : write(40,*) ' '
520 44 : write(40,*) ' In cartesian coordinates:'
521 314 : do ii=1,qpt_tot
522 314 : write(40,'(a,1x,3(f10.5,1x))') Qpt%special_qpt(ii),Qpt%special_cart(ii,1),Qpt%special_cart(ii,2),Qpt%special_cart(ii,3)
523 : end do
524 44 : write(40,*) ' '
525 44 : write(40,*) ' Using gprimt='
526 44 : write(40,'(3(f10.5,1x))') Lattice%gprimt(1,1),Lattice%gprimt(1,2),Lattice%gprimt(1,3)
527 44 : write(40,'(3(f10.5,1x))') Lattice%gprimt(2,1),Lattice%gprimt(2,2),Lattice%gprimt(2,3)
528 44 : write(40,'(3(f10.5,1x))') Lattice%gprimt(3,1),Lattice%gprimt(3,2),Lattice%gprimt(3,3)
529 44 : write(40,*) ' '
530 44 : write(40,*) ' The number of points along each direction in the BZ='
531 44 : if (qpt_tot.gt.1) then
532 270 : do ii=1,qpt_tot-1
533 270 : write(40,'(a2,a,a2,1x,i4)') Qpt%special_qpt(ii),'-',Qpt%special_qpt(ii+1),Qpt%lgth_segments(ii)
534 : end do
535 : end if
536 : end if
537 :
538 : else
539 0 : write(Invar%stdout,*) 'The Q points path is defined in the input file'
540 0 : if (MPIdata%iam_master) write(40,*) 'The Q points path is defined in the input file'
541 0 : nqpt=abs(Invar%bzpath)
542 0 : ABI_MALLOC(Qpt%qpt_red ,(3,nqpt)); Qpt%qpt_red (:,:)=zero
543 0 : ABI_MALLOC(Qpt%qpt_cart,(3,nqpt)); Qpt%qpt_cart(:,:)=zero
544 0 : Qpt%qpt_red(:,:)=Invar%qpt(:,:)
545 0 : ABI_ERROR('The indices in the loop below are not consistent')
546 0 : do ii=1,nqpt
547 0 : do jj=1,3
548 0 : do kk=1,3
549 0 : if (Lattice%line==2) then
550 0 : Qpt%qpt_cart(ii,jj)=Qpt%qpt_cart(ii,jj)+Lattice%gprimt(kk,jj)*Qpt%qpt_red(ii,kk)/Lattice%acell_unitcell(jj)
551 0 : else if (Lattice%line==0.or.Lattice%line==1) then
552 0 : Qpt%qpt_cart(ii,jj)=Qpt%qpt_cart(ii,jj)+Lattice%gprimt(kk,jj)*Qpt%qpt_red(ii,kk)/Lattice%acell_unitcell(kk)
553 : end if
554 : end do
555 : end do
556 : end do
557 : end if !BZpath>=0
558 44 : write(Invar%stdout,*) 'See the qpt.dat file'
559 :
560 : ! Write the q-points along the path defined in the BZ, in the qpt.dat file
561 44 : if (MPIdata%iam_master) then
562 44 : write(40,*) ' '
563 44 : write(40,*) ' Q-points path (in reduced coordinates) and (in cartesian coordinates)='
564 22632 : do iqpt=1,nqpt
565 22588 : write(40,'(i4,1x,6(f10.5,1x))') iqpt,Qpt%qpt_red(1,iqpt),Qpt%qpt_red(2,iqpt),Qpt%qpt_red(3,iqpt),&
566 45220 : & Qpt%qpt_cart(1,iqpt),Qpt%qpt_cart(2,iqpt),Qpt%qpt_cart(3,iqpt)
567 : end do
568 44 : close(40)
569 : end if
570 44 : Qpt%nqpt=nqpt
571 44 : ABI_FREE(QptBound)
572 44 : end subroutine tdep_make_qptpath
573 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
574 :
575 44 : subroutine tdep_destroy_qpt(Qpt)
576 :
577 : type(Qpoints_type),intent(inout) :: Qpt
578 :
579 44 : ABI_FREE(Qpt%special_qpt)
580 44 : ABI_FREE(Qpt%special_red)
581 44 : ABI_FREE(Qpt%special_cart)
582 44 : ABI_FREE(Qpt%lgth_segments)
583 44 : ABI_FREE(Qpt%qpt_red)
584 44 : ABI_FREE(Qpt%qpt_cart)
585 :
586 44 : end subroutine tdep_destroy_qpt
587 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
588 :
589 0 : end module m_tdep_qpt
|
