Branch data 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
# # # # #
# # # # #
# # # # #
# # # #
# ]
|
