Branch data Line data Source code
1 : : !!****m* ABINIT/m_eph_double_grid
2 : : !! NAME
3 : : !! m_eph_double_grid
4 : : !!
5 : : !! FUNCTION
6 : : !! Structure and functions to create a double grid mapping
7 : : !!
8 : : !! COPYRIGHT
9 : : !! Copyright (C) 2008-2026 ABINIT group (HM)
10 : : !! This file is distributed under the terms of the
11 : : !! GNU General Public License, see ~abinit/COPYING
12 : : !! or http://www.gnu.org/copyleft/gpl.txt .
13 : : !!
14 : : !! SOURCE
15 : :
16 : : #if defined HAVE_CONFIG_H
17 : : #include "config.h"
18 : : #endif
19 : :
20 : : #include "abi_common.h"
21 : :
22 : : module m_eph_double_grid
23 : :
24 : : use defs_basis
25 : : use m_errors
26 : : use m_ebands
27 : : use m_abicore
28 : :
29 : : use m_numeric_tools, only : wrap2_pmhalf
30 : : use m_matrix, only : mati3inv
31 : : use m_crystal, only : crystal_t
32 : : use m_kpts, only : kpts_timrev_from_kptopt !, listkk
33 : : use m_fstrings, only : itoa, sjoin
34 : :
35 : : implicit none
36 : :
37 : : private
38 : : !!***
39 : :
40 : : !----------------------------------------------------------------------
41 : :
42 : : !!****t* m_eph_double_grid/eph_double_grid_t
43 : : !! NAME
44 : : !! eph_double_grid_t
45 : : !!
46 : : !! FUNCTION
47 : : !! Double grid datatype for electron-phonon
48 : : !!
49 : : !! SOURCE
50 : :
51 : : type,public :: eph_double_grid_t
52 : :
53 : : type(ebands_t) :: ebands_dense
54 : : ! ebands structure with the eigenvalues on the dense grid
55 : : ! TODO: Should be replaced by ebands_dense%eig to reduce memory requirements (occ, kpts ...)
56 : :
57 : : integer :: coarse_nbz, dense_nbz, dense_nibz
58 : :
59 : : real(dp),allocatable :: weights_dense(:)
60 : : !weights in the dense grid
61 : :
62 : : integer,allocatable :: bz2ibz_coarse(:)
63 : : ! map full Brillouin zone to ibz (in the coarse grid)
64 : :
65 : : integer,allocatable :: bz2ibz_dense(:)
66 : : ! map full Brillouin zone to ibz (in the dense grid)
67 : :
68 : : integer :: nkpt_coarse(3), nkpt_dense(3)
69 : : ! size of the coarse and dense meshes
70 : :
71 : : integer :: interp_kmult(3)
72 : : ! multiplicity of the meshes
73 : :
74 : : integer :: ndiv = 1
75 : : ! ndiv = interp_kmult(1)*interp_kmult(2)*interp_kmult(3)
76 : :
77 : : ! the integer indexes for the coarse grid are calculated for kk(3) with:
78 : : ! [mod(nint((kpt(1)+1)*self%nkpt_coarse(1)),self%nkpt_coarse(1))+1,
79 : : ! mod(nint((kpt(2)+1)*self%nkpt_coarse(2)),self%nkpt_coarse(2))+1,
80 : : ! mod(nint((kpt(3)+1)*self%nkpt_coarse(3)),self%nkpt_coarse(3))+1]
81 : :
82 : : integer,allocatable :: indexes_to_coarse(:,:,:)
83 : : ! given integer indexes get the array index of the kpoint (coarse)
84 : :
85 : : integer,allocatable :: coarse_to_indexes(:,:)
86 : : ! given the array index get the integer indexes of the kpoints (coarse)
87 : :
88 : : integer,allocatable :: indexes_to_dense(:,:,:)
89 : : ! given integer indexes get the array index of the kpoint (dense)
90 : :
91 : : integer,allocatable :: dense_to_indexes(:,:)
92 : : ! given the array index get the integer indexes of the kpoint (dense)
93 : :
94 : : integer,allocatable :: coarse_to_dense(:,:)
95 : : ! map coarse to dense mesh (nbz_coarse,mult(interp_kmult))
96 : :
97 : : integer,allocatable :: bz2lgkibz(:)
98 : : ! map full brillouin zone of dense grid to a little group of k
99 : :
100 : : integer,allocatable :: mapping(:,:)
101 : : ! map k, k+q and q in the IBZ and FBZ of the double grid structure
102 : :
103 : : contains
104 : :
105 : : procedure :: free => eph_double_grid_free
106 : : ! Free the double grid structure
107 : :
108 : : procedure :: get_index => eph_double_grid_get_index
109 : : ! Get the index of the the kpoint in the double grid
110 : :
111 : : procedure :: bz2ibz => eph_double_grid_bz2ibz
112 : : ! Map BZ to IBZ using the double grid structure
113 : :
114 : : procedure :: get_mapping => eph_double_grid_get_mapping
115 : : ! Get a mapping of k, k+q and q to the BZ and IBZ of the double grid
116 : :
117 : : end type eph_double_grid_t
118 : : !!***
119 : :
120 : : public :: eph_double_grid_new ! Initialize the double grid structure
121 : :
122 : : contains !=====================================================
123 : : !!***
124 : :
125 : : !----------------------------------------------------------------------
126 : :
127 : : !!****f* m_sigmaph/eph_double_grid_new
128 : : !! NAME
129 : : !!
130 : : !! FUNCTION
131 : : !! Prepare Double grid integration
132 : : !!
133 : : !! double grid:
134 : : !! ----------------- interp_kmult 2
135 : : !! |. .|.|.|.|. . .| side 1
136 : : !! |. x|.|x|.|. x .| size 3 (2*side+1)
137 : : !! |. .|.|.|.|. . .|
138 : : !! -----------------
139 : : !!
140 : : !! triple grid:
141 : : !! ------------------- interp_kmult 3
142 : : !! |. . .|. . .|. . .| side 1
143 : : !! |. x .|. x .|. x .| size 3 (2*side+1)
144 : : !! |. . .|. . .|. . .|
145 : : !! -------------------
146 : : !!
147 : : !! quadruple grid:
148 : : !! --------------------------- interp_kmult 4
149 : : !! |. . . .|.|. . .|.|. . . .| side 2
150 : : !! |. . . .|.|. . .|.|. . . .| size 5 (2*side+1)
151 : : !! |. . x .|.|. x .|.|. x . .|
152 : : !! |. . . .|.|. . .|.|. . . .|
153 : : !! |. . . .|.|. . .|.|. . . .|
154 : : !! ---------------------------
155 : : !!
156 : : !! . = double grid
157 : : !! x = coarse grid
158 : : !!
159 : : !! The fine grid is used to evaluate the weights on the coarse grid
160 : : !! The points of the fine grid are associated to the points of the
161 : : !! coarse grid according to proximity
162 : : !! The integration weights are returned on the coarse grid.
163 : : !!
164 : : !! Steps of the implementation
165 : : !! 1. Get the fine k grid from file or interpolation (ebands_dense)
166 : : !! 2. Find the matching between the k_coarse and k_dense using the double_grid object
167 : : !! 3. Calculate the phonon frequencies on the dense mesh and store them on a array
168 : : !! 4. Create an array to bring the points in the full brillouin zone to the irreducible brillouin zone
169 : : !! 5. Create a scatter array between the points in the fine grid
170 : : !!
171 : : !! INPUTS
172 : : !!
173 : : !! SOURCE
174 : :
175 : 7 : type(eph_double_grid_t) function eph_double_grid_new(cryst, ebands_dense, kptrlatt_coarse, kptrlatt_dense) result(eph_dg)
176 : :
177 : : !Arguments-------------------------------
178 : : type(crystal_t), intent(in) :: cryst
179 : : type(ebands_t), intent(in) :: ebands_dense
180 : : integer, intent(in) :: kptrlatt_coarse(3,3), kptrlatt_dense(3,3)
181 : :
182 : : !Local variables ------------------------
183 : : !integer,parameter :: sppoldbl1 = 1
184 : : integer :: i_dense,i_coarse,this_dense,i_subdense,i1,i2,i3,ii,jj,kk,timrev
185 : : integer :: nkpt_coarse(3), nkpt_dense(3), interp_kmult(3), interp_side(3)
186 : : !integer,allocatable :: indkk(:,:)
187 : :
188 : : ! *************************************************************************
189 : :
190 : 7 : timrev = kpts_timrev_from_kptopt(ebands_dense%kptopt)
191 : :
192 : 7 : nkpt_coarse(1) = kptrlatt_coarse(1,1)
193 : 7 : nkpt_coarse(2) = kptrlatt_coarse(2,2)
194 : 7 : nkpt_coarse(3) = kptrlatt_coarse(3,3)
195 : 7 : nkpt_dense(1) = kptrlatt_dense(1,1)
196 : 7 : nkpt_dense(2) = kptrlatt_dense(2,2)
197 : 7 : nkpt_dense(3) = kptrlatt_dense(3,3)
198 : :
199 : 7 : eph_dg%dense_nbz = nkpt_dense(1)*nkpt_dense(2)*nkpt_dense(3)
200 : 7 : eph_dg%coarse_nbz = nkpt_coarse(1)*nkpt_coarse(2)*nkpt_coarse(3)
201 [ + + ]: 28 : interp_kmult = nkpt_dense/nkpt_coarse
202 [ + + ]: 28 : eph_dg%interp_kmult = interp_kmult
203 [ + + ]: 28 : eph_dg%nkpt_coarse = nkpt_coarse
204 [ + + ]: 28 : eph_dg%nkpt_dense = nkpt_dense
205 : 7 : call ebands_dense%copy(eph_dg%ebands_dense)
206 : :
207 : : ! A microzone is the set of points in the fine grid belonging to a certain coarse point
208 : : ! we have to consider a side of a certain size around the coarse point
209 : : ! to make sure the microzone is centered around its point.
210 : : ! The fine points shared by multiple microzones should have weights
211 : : ! according to in how many microzones they appear
212 : : !
213 : : ! this is integer division
214 [ + + ]: 28 : interp_side = interp_kmult/2
215 : :
216 : : eph_dg%ndiv = (2*interp_side(1)+1)*&
217 : : (2*interp_side(2)+1)*&
218 : 7 : (2*interp_side(3)+1)
219 : :
220 : 7 : write(std_out,*) 'coarse: ', nkpt_coarse
221 : 7 : write(std_out,*) 'fine: ', nkpt_dense
222 : 7 : write(std_out,*) 'interp_kmult:', interp_kmult
223 : 7 : write(std_out,*) 'ndiv: ', eph_dg%ndiv
224 : :
225 [ + + + - : 28 : ABI_CHECK(all(nkpt_dense(:) >= nkpt_coarse(:)), 'fine mesh is smaller than coarse mesh.')
- + ]
226 : :
227 [ - + + - : 28 : ABI_MALLOC(eph_dg%coarse_to_dense, (eph_dg%coarse_nbz, eph_dg%ndiv))
- + + - +
- + - - +
- + - + ]
228 : :
229 [ - + + - : 21 : ABI_MALLOC(eph_dg%dense_to_indexes, (3, eph_dg%dense_nbz))
+ - + - -
+ - + -
+ ]
230 [ - + + - : 35 : ABI_MALLOC(eph_dg%indexes_to_dense, (nkpt_dense(1), nkpt_dense(2), nkpt_dense(3)))
- + + - -
+ + - + -
+ - - + -
+ - + ]
231 : :
232 [ - + + - : 14 : ABI_MALLOC(eph_dg%coarse_to_indexes, (3, eph_dg%dense_nbz))
- + - + -
+ ]
233 [ - + + - : 35 : ABI_MALLOC(eph_dg%indexes_to_coarse, (nkpt_coarse(1), nkpt_coarse(2), nkpt_coarse(3)))
- + + - -
+ + - + -
+ - - + -
+ - + ]
234 : :
235 [ - + + - : 21 : ABI_MALLOC(eph_dg%bz2lgkibz, (eph_dg%dense_nbz))
+ - + - -
+ - + -
+ ]
236 [ - + + - : 21 : ABI_MALLOC(eph_dg%mapping, (6, eph_dg%ndiv))
+ - + - -
+ - + -
+ ]
237 [ - + + - : 21 : ABI_MALLOC(eph_dg%weights_dense, (eph_dg%dense_nbz))
+ - + - -
+ - + -
+ ]
238 : :
239 : 7 : write(std_out,*) 'create fine to coarse mapping'
240 : : ! generate mapping of points in dense bz to the dense bz
241 : : ! coarse loop
242 : 7 : i_dense = 0
243 : 7 : i_coarse = 0
244 [ + + ]: 55 : do kk=1,nkpt_coarse(3)
245 [ + + ]: 727 : do jj=1,nkpt_coarse(2)
246 [ + + ]: 14928 : do ii=1,nkpt_coarse(1)
247 : 14208 : i_coarse = i_coarse + 1
248 : : !calculate reduced coordinates of point in coarse mesh
249 : : !eph_dg%kpts_coarse(:,i_coarse) = [dble(ii-1)/nkpt_coarse(1),&
250 : : ! dble(jj-1)/nkpt_coarse(2),&
251 : : ! dble(kk-1)/nkpt_coarse(3)]
252 : : !call wrap2_pmhalf(dble(ii-1)/nkpt_coarse(1),eph_dg%kpts_coarse(1,i_coarse),shift)
253 : : !call wrap2_pmhalf(dble(jj-1)/nkpt_coarse(2),eph_dg%kpts_coarse(2,i_coarse),shift)
254 : : !call wrap2_pmhalf(dble(kk-1)/nkpt_coarse(3),eph_dg%kpts_coarse(3,i_coarse),shift)
255 : :
256 : : !create the fine mesh
257 [ + + ]: 42624 : do i3=1,interp_kmult(3)
258 [ + + ]: 99456 : do i2=1,interp_kmult(2)
259 [ + + ]: 198912 : do i1=1,interp_kmult(1)
260 : 113664 : i_dense = i_dense + 1
261 : : !calculate reduced coordinates of point in dense mesh
262 : : !eph_dg%kpts_dense(:,i_dense) = &
263 : : ! [dble((ii-1)*interp_kmult(1)+i1-1)/(nkpt_coarse(1)*interp_kmult(1)),&
264 : : ! dble((jj-1)*interp_kmult(2)+i2-1)/(nkpt_coarse(2)*interp_kmult(2)),&
265 : : ! dble((kk-1)*interp_kmult(3)+i3-1)/(nkpt_coarse(3)*interp_kmult(3))]
266 : : !call wrap2_pmhalf((dble(ii-1)*interp_kmult(1)+i1-1)/(nkpt_coarse(1)*interp_kmult(1)), &
267 : : ! eph_dg%kpts_dense(1,i_dense),shift)
268 : : !call wrap2_pmhalf((dble(jj-1)*interp_kmult(2)+i2-1)/(nkpt_coarse(2)*interp_kmult(2)), &
269 : : ! eph_dg%kpts_dense(2,i_dense),shift)
270 : : !call wrap2_pmhalf((dble(kk-1)*interp_kmult(3)+i3-1)/(nkpt_coarse(3)*interp_kmult(3)), &
271 : : ! eph_dg%kpts_dense(3,i_dense),shift)
272 : :
273 : : !integer indexes mapping
274 : : eph_dg%indexes_to_dense((ii-1)*interp_kmult(1)+i1,&
275 : : (jj-1)*interp_kmult(2)+i2,&
276 : 113664 : (kk-1)*interp_kmult(3)+i3) = i_dense
277 : : eph_dg%dense_to_indexes(:,i_dense) = [(ii-1)*interp_kmult(1)+i1,&
278 : : (jj-1)*interp_kmult(2)+i2,&
279 [ + + ]: 511488 : (kk-1)*interp_kmult(3)+i3]
280 : : enddo
281 : : enddo
282 : : enddo
283 : 14208 : eph_dg%indexes_to_coarse(ii,jj,kk) = i_coarse
284 [ + + ]: 57504 : eph_dg%coarse_to_indexes(:,i_coarse) = [ii, jj, kk]
285 : : enddo
286 : : enddo
287 : : enddo
288 : :
289 : : ! here we need to iterate again because we can have points of the dense grid
290 : : ! belonging to multiple coarse points
291 : : i_coarse = 0
292 [ + + ]: 55 : do kk=1,nkpt_coarse(3)
293 [ + + ]: 727 : do jj=1,nkpt_coarse(2)
294 [ + + ]: 14928 : do ii=1,nkpt_coarse(1)
295 : 14208 : i_coarse = i_coarse + 1
296 : :
297 : : !create a mapping from coarse to dense
298 : 14208 : i_subdense = 0
299 [ + + ]: 57504 : do i3=-interp_side(3),interp_side(3)
300 [ + + ]: 184704 : do i2=-interp_side(2),interp_side(2)
301 [ + + ]: 554112 : do i1=-interp_side(1),interp_side(1)
302 : 383616 : i_subdense = i_subdense + 1
303 : : !integer indexes mapping
304 : : this_dense = eph_dg%indexes_to_dense(&
305 : : mod((ii-1)*interp_kmult(1)+i1+nkpt_dense(1),nkpt_dense(1))+1,&
306 : : mod((jj-1)*interp_kmult(2)+i2+nkpt_dense(2),nkpt_dense(2))+1,&
307 : 383616 : mod((kk-1)*interp_kmult(3)+i3+nkpt_dense(3),nkpt_dense(3))+1)
308 : :
309 : : !array indexes mapping
310 : 511488 : eph_dg%coarse_to_dense(i_coarse,i_subdense) = this_dense
311 : : enddo
312 : : enddo
313 : : enddo
314 : : enddo
315 : : enddo
316 : : enddo
317 : :
318 [ - + ]: 7 : ABI_CHECK(i_dense == eph_dg%dense_nbz, 'fine mesh mapping is incomplete')
319 : :
320 : : !calculate the weights of each fine point
321 : : !different methods to distribute the weights might lead to better convergence
322 : : !loop over coarse points
323 [ + + ]: 113671 : eph_dg%weights_dense = 0
324 [ + + ]: 14215 : do ii=1,eph_dg%coarse_nbz
325 : : !loop over points in the microzone
326 [ + + ]: 397831 : do jj=1,eph_dg%ndiv
327 : 383616 : i_dense = eph_dg%coarse_to_dense(ii,jj)
328 : 397824 : eph_dg%weights_dense(i_dense) = eph_dg%weights_dense(i_dense) + 1
329 : : end do
330 : : end do
331 : : !weights_dense is array, ndiv is scalar
332 [ + + ]: 113671 : eph_dg%weights_dense = 1/eph_dg%weights_dense/(interp_kmult(1)*interp_kmult(2)*interp_kmult(3))
333 : :
334 : : !3.
335 : 7 : eph_dg%dense_nibz = ebands_dense%nkpt
336 : :
337 : : !4.
338 : 7 : write(std_out,*) 'map bz -> ibz'
339 [ - + + - : 14 : ABI_MALLOC(eph_dg%bz2ibz_dense,(eph_dg%dense_nbz))
- + - + -
+ ]
340 : : call eph_double_grid_bz2ibz(eph_dg, ebands_dense%kptns, eph_dg%dense_nibz,&
341 : 7 : cryst%symrel, cryst%nsym, eph_dg%bz2ibz_dense, timrev)
342 : :
343 : : !ABI_MALLOC(indkk,(eph_dg%dense_nbz,6))
344 : : !call listkk(dksqmax, cryst%gmet, indkk, ebands_dense%kptns, eph_dg%kpts_dense,&
345 : : ! eph_dg%dense_nibz, eph_dg%dense_nbz, cryst%nsym,&
346 : : ! sppoldbl1, cryst%symafm, cryst%symrel, timrev, use_symrec=.False.)
347 : :
348 : : !do ii=1,eph_dg%dense_nbz
349 : : ! ABI_CHECK((indkk(ii,1)==eph_dg%bz2ibz_dense(ii)),'Unmatching indexes')
350 : : !end do
351 : : !ABI_FREE(indkk)
352 : :
353 : 7 : end function eph_double_grid_new
354 : : !!***
355 : :
356 : : !!****f* m_sigmaph/eph_double_grid_free
357 : : !! NAME
358 : : !!
359 : : !! FUNCTION
360 : : !! Free memory
361 : : !!
362 : : !! INPUTS
363 : : !!
364 : : !! SOURCE
365 : :
366 : 131 : subroutine eph_double_grid_free(self)
367 : :
368 : : class(eph_double_grid_t),intent(inout) :: self
369 : :
370 [ + + ]: 131 : ABI_SFREE(self%weights_dense)
371 [ + + ]: 131 : ABI_SFREE(self%bz2ibz_dense)
372 [ + + ]: 131 : ABI_SFREE(self%coarse_to_dense)
373 [ + + ]: 131 : ABI_SFREE(self%dense_to_indexes)
374 [ + + ]: 131 : ABI_SFREE(self%indexes_to_dense)
375 [ + + ]: 131 : ABI_SFREE(self%coarse_to_indexes)
376 [ + + ]: 131 : ABI_SFREE(self%indexes_to_coarse)
377 [ + + ]: 131 : ABI_SFREE(self%bz2lgkibz)
378 [ + + ]: 131 : ABI_SFREE(self%mapping)
379 : :
380 : 131 : call self%ebands_dense%free()
381 : :
382 : 131 : end subroutine eph_double_grid_free
383 : : !!***
384 : :
385 : : !------------------------------------------------------------------------
386 : :
387 : : !!****f* m_sigmaph/eph_double_grid_get_index
388 : : !! NAME
389 : : !!
390 : : !! FUNCTION
391 : : !! Get the indeex of a certain k-point in the double grid
392 : : !!
393 : : !! INPUTS
394 : : !! kpt=kpoint to be mapped (reduced coordinates)
395 : : !! opt=Map to the coarse (1) or dense grid (2)
396 : : !!
397 : : !! SOURCE
398 : :
399 : 1500899 : integer function eph_double_grid_get_index(self,kpt,opt) result(ikpt)
400 : :
401 : : class(eph_double_grid_t),intent(in) :: self
402 : : integer,intent(in) :: opt
403 : : real(dp),intent(in) :: kpt(3)
404 : :
405 : : !Local variables ------------------------
406 : : real(dp) :: wrap_kpt(3), shift
407 : :
408 : : ! *************************************************************************
409 : :
410 : 1500899 : call wrap2_pmhalf(kpt(1),wrap_kpt(1),shift)
411 : 1500899 : call wrap2_pmhalf(kpt(2),wrap_kpt(2),shift)
412 : 1500899 : call wrap2_pmhalf(kpt(3),wrap_kpt(3),shift)
413 : :
414 [ + + ]: 1500899 : if (opt==1) then
415 : : ikpt = self%indexes_to_coarse(&
416 : : mod(nint((wrap_kpt(1)+2)*self%nkpt_coarse(1)),self%nkpt_coarse(1))+1,&
417 : : mod(nint((wrap_kpt(2)+2)*self%nkpt_coarse(2)),self%nkpt_coarse(2))+1,&
418 : 282324 : mod(nint((wrap_kpt(3)+2)*self%nkpt_coarse(3)),self%nkpt_coarse(3))+1)
419 [ + - ]: 1218575 : else if (opt==2) then
420 : : ikpt = self%indexes_to_dense(&
421 : : mod(nint((wrap_kpt(1)+2)*self%nkpt_dense(1)),self%nkpt_dense(1))+1,&
422 : : mod(nint((wrap_kpt(2)+2)*self%nkpt_dense(2)),self%nkpt_dense(2))+1,&
423 : 1218575 : mod(nint((wrap_kpt(3)+2)*self%nkpt_dense(3)),self%nkpt_dense(3))+1)
424 : : else
425 : 0 : ABI_ERROR(sjoin("Error in eph_double_grid_get_index opt. Possible values are 1 or 2. Got", itoa(opt)))
426 : : endif
427 : :
428 : 1500899 : end function eph_double_grid_get_index
429 : : !!***
430 : :
431 : : !----------------------------------------------------------------------
432 : :
433 : : !!****f* m_sigmaph/eph_double_grid_bz2ibz
434 : : !! NAME
435 : : !! eph_double_grid_bz2ibz
436 : : !!
437 : : !! FUNCTION
438 : : !! Map the points of the full to the irreducible Brillouin zone using the
439 : : !! indexes grid used in the double grid structure
440 : : !!
441 : : !! INPUTS
442 : : !! kpt_ibz: list of kpoints coordinated in the irreducible Brillouin zone
443 : : !! nibz: number of points in the irreducible Brillouin zone
444 : : !! symmat: symmetry operations
445 : : !! nsym: number of symmetry operations
446 : : !! bz2ibz: indexes mapping bz to ibz
447 : : !!
448 : : !! OUTPUT
449 : : !!
450 : : !! SOURCE
451 : :
452 : 0 : subroutine eph_double_grid_bz2ibz(self,kpt_ibz,nibz,symmat,nsym,bz2ibz,timrev,mapping,use_symrec)
453 : :
454 : : class(eph_double_grid_t),intent(in) :: self
455 : : integer,intent(in) :: nibz, nsym
456 : : real(dp),intent(in) :: kpt_ibz(3,nibz)
457 : : integer,intent(in) :: symmat(3,3,nsym)
458 : : integer,intent(out):: bz2ibz(self%dense_nbz)
459 : : integer,intent(in) :: timrev
460 : : logical,optional,intent(in) :: use_symrec
461 : : integer,optional,intent(inout) :: mapping(self%dense_nbz,3)
462 : :
463 : : !Local variables ------------------------
464 : : integer :: isym, ik_ibz, ik_bz
465 : : real(dp) :: kpt(3), kpt_sym(3), wrap_kpt(3), shift
466 : : integer :: itimrev, timrev_used, counter
467 : : logical :: do_use_symrec
468 : :
469 : : !************************************************************************
470 : :
471 : 45 : timrev_used=timrev
472 : :
473 : 45 : do_use_symrec=.False.
474 [ + + ]: 45 : if (present(use_symrec)) then
475 [ - + ]: 38 : if (use_symrec) then
476 : 45 : do_use_symrec=.True.
477 : : end if
478 : : end if
479 : :
480 : : !call cwtime(cpu,wall,gflops,"start")
481 [ + + ]: 793645 : bz2ibz = 0
482 : : ! Loop over the star of q
483 : : counter = 0
484 [ + - ]: 46 : outer: do itimrev=0,timrev_used
485 [ + + ]: 850 : do isym=1,nsym
486 [ + + ]: 879367 : do ik_ibz=1,nibz
487 : : ! get coordinates of k point
488 [ + + ]: 3514428 : kpt(:) = kpt_ibz(:,ik_ibz)
489 : : ! Get the symmetric of q
490 [ + + ]: 878607 : if (do_use_symrec) then
491 [ + + + + : 20646192 : kpt_sym(:) = (1-2*itimrev)*matmul(symmat(:,:,isym),kpt)
+ + + + +
+ ]
492 : : else
493 [ + + + + : 3954804 : kpt_sym(:) = (1-2*itimrev)*matmul(transpose(symmat(:,:,isym)),kpt)
+ + + + +
+ ]
494 : : endif
495 : : ! get the index of the ibz point in bz
496 : 878607 : call wrap2_pmhalf(kpt_sym(1),wrap_kpt(1),shift)
497 : 878607 : call wrap2_pmhalf(kpt_sym(2),wrap_kpt(2),shift)
498 : 878607 : call wrap2_pmhalf(kpt_sym(3),wrap_kpt(3),shift)
499 : 878607 : ik_bz = self%get_index(wrap_kpt, 2)
500 : :
501 : : ! check if applying this symmetry operation to kpt gives kpt_dense
502 [ + + ]: 879366 : if (bz2ibz(ik_bz)==0) then
503 : : !if (((self%kpts_dense(1,ik_bz)-wrap_kpt(1))**2+&
504 : : ! (self%kpts_dense(2,ik_bz)-wrap_kpt(2))**2+&
505 : : ! (self%kpts_dense(3,ik_bz)-wrap_kpt(3))**2)<tol6) then
506 : 793600 : bz2ibz(ik_bz) = ik_ibz
507 [ - + ]: 793600 : if (present(mapping)) then
508 : 0 : mapping(ik_bz,1) = isym
509 : 0 : mapping(ik_bz,2) = itimrev
510 : : endif
511 : 793600 : counter = counter + 1
512 [ + + ]: 793600 : if (counter==self%dense_nbz) exit outer
513 : : !end if
514 : : end if
515 : : end do
516 : : end do
517 : : end do outer
518 : :
519 : : !check
520 [ + + ]: 793645 : do ik_bz=1,self%dense_nbz
521 [ - + ]: 793645 : ABI_CHECK(bz2ibz(ik_bz).ne.0,'Mapping not found')
522 : : end do
523 : :
524 [ - + ]: 45 : end subroutine eph_double_grid_bz2ibz
525 : : !!***
526 : :
527 : : !----------------------------------------------------------------------
528 : :
529 : : !!****f* m_sigmaph/eph_double_grid_get_mapping
530 : : !! NAME
531 : : !! eph_double_grid_get_mapping
532 : : !!
533 : : !! FUNCTION
534 : : !! Campute mapping of k, k+q and q to the indexes in the double grid structure
535 : : !!
536 : : !! INPUTS
537 : : !! kk, kq, qpt: reduced coordinates of k, k+q and q to be mapped
538 : : !!
539 : : !! OUTPUT
540 : : !! mapping: array with the mapping of k, k+q and q to the BZ and IBZ of the double grid structure
541 : : !!
542 : : !! SOURCE
543 : :
544 : 94108 : subroutine eph_double_grid_get_mapping(self,kk,kq,qpt)
545 : :
546 : : !Arguments --------------------------------
547 : : class(eph_double_grid_t),intent(inout) :: self
548 : : real(dp),intent(in) :: kk(3), kq(3), qpt(3)
549 : :
550 : : !Variables --------------------------------
551 : : integer :: jj
552 : : integer :: ik_bz, ikq_bz, iq_bz
553 : : integer :: ik_ibz_fine,iq_ibz_fine,ikq_ibz_fine,ik_bz_fine,ikq_bz_fine,iq_bz_fine
554 : :
555 : 94108 : ik_bz = self%get_index(kk, 1)
556 : 94108 : ikq_bz = self%get_index(kq, 1)
557 : 94108 : iq_bz = self%get_index(qpt, 1)
558 : :
559 : 94108 : ik_bz_fine = self%coarse_to_dense(ik_bz,1)
560 : 94108 : ik_ibz_fine = self%bz2ibz_dense(ik_bz_fine)
561 : :
562 : : !fine grid around kq
563 [ + + ]: 2635024 : do jj=1,self%ndiv
564 : :
565 : : !kq
566 : 2540916 : ikq_bz_fine = self%coarse_to_dense(ikq_bz,jj)
567 : 2540916 : ikq_ibz_fine = self%bz2ibz_dense(ikq_bz_fine)
568 : :
569 : : !qq
570 : 2540916 : iq_bz_fine = self%coarse_to_dense(iq_bz,jj)
571 : 2540916 : iq_ibz_fine = self%bz2ibz_dense(iq_bz_fine)
572 : :
573 : : self%mapping(:, jj) = &
574 : : [ik_bz_fine, ikq_bz_fine, iq_bz_fine,&
575 [ + + ]: 17880520 : ik_ibz_fine, ikq_ibz_fine, iq_ibz_fine]
576 : : enddo
577 : :
578 : 94108 : end subroutine eph_double_grid_get_mapping
579 : : !!***
580 : :
581 [ # # # # : 0 : end module m_eph_double_grid
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # #
# ]
582 : : !!***
|
