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 : !!***
|
