Branch data Line data Source code
1 : : !!****m* ABINIT/m_tdep_supercell
2 : : !! NAME
3 : : !! m_tdep_supercell
4 : : !!
5 : : !! FUNCTION
6 : : !! Module for defining a supercell for the purpose of aTDEP
7 : : !!
8 : : !! COPYRIGHT
9 : : !! Copyright (C) 2026-2026 ABINIT group (GA)
10 : : !! This file is distributed under the terms of the
11 : : !! GNU General Public Licence, see ~abinit/COPYING
12 : : !! or http://www.gnu.org/copyleft/gpl.txt .
13 : : !! For the initials of contributors, see ~abinit/doc/developers/contributors.txt .
14 : : !!
15 : : !! SOURCE
16 : :
17 : : #if defined HAVE_CONFIG_H
18 : : #include "config.h"
19 : : #endif
20 : :
21 : : #include "abi_common.h"
22 : :
23 : : module m_tdep_supercell
24 : :
25 : : use defs_basis
26 : : use m_io_tools
27 : : use m_abicore
28 : : use m_errors
29 : : use m_xmpi
30 : :
31 : : use m_numeric_tools, only : wrap2_pmhalf
32 : : use m_matrix, only : matr3inv, mati3det, mati3HNF
33 : : use m_atomdata, only : znucl2symbol
34 : : use m_crystal, only : crystal_t
35 : :
36 : :
37 : : implicit none
38 : : !!***
39 : :
40 : : !----------------------------------------------------------------------
41 : :
42 : : !!****t* m_tdep_supercell/tdep_Supercell_type
43 : : !! NAME
44 : : !! tdep_Supercell_type
45 : : !!
46 : : !! FUNCTION
47 : : !! Supercell defined by an integer matrix (S).
48 : : !!
49 : : !! A supercell holds N unitcell and N lattice vectors R, with
50 : : !! N = det(S).
51 : : !! Different supercell matrices are equivalent if they have the same Hermite normal form (H).
52 : : !!
53 : : !! The Hermite normal form allows to enumerate a set of canonical lattice vectors (Rcan),
54 : : !! which form a compact box, in reduced coordinates.
55 : : !!
56 : : !! Any lattice vector R can be decomposed as
57 : : !! R = (H * t) + Rcan
58 : : !! where t(3) is an integer vector. This decomposition defines the modulo operation
59 : : !! with respect to H (modH) as
60 : : !! Rcan = modH(R)
61 : : !! Two R vectors are equivalent if they correspond to the same canonical vector.
62 : : !!
63 : : !! A supercell shift (R_sh) is a lattice vector whose canonical coordinates are zero.
64 : : !!
65 : : !! Since the canonical lattice vectors form a compact box,
66 : : !! there exist a natural order to enumerate the lattice vectors,
67 : : !! and therefore there is a natural ordering for the atoms of the supercell.
68 : : !!
69 : : !! Note that the Canonical coordinates of the R vectors in this context
70 : : !! are not the same as the canonical coordinates read by the IFC,
71 : : !! which correspond here to the reduced coordinates of R vectors.
72 : : !!
73 : : !! The supercell defines three different coordinate systems within a supercell:
74 : : !! cartesian coordinates, unitcell reduced coordinates, supercell reduced coordinates.
75 : : !!
76 : : !! GA: Should eventually replace m_dynmat/make_bigbox and m_supercell
77 : : !!
78 : : !! SOURCE
79 : :
80 : : type tdep_Supercell_type
81 : :
82 : : integer :: natom
83 : : ! Number of atoms in the supercell.
84 : :
85 : : integer :: ntypat
86 : : ! Number of atom types.
87 : :
88 : : integer :: natom_unitcell
89 : : ! Number of atoms in the unitcell
90 : :
91 : : integer :: Ncells
92 : : ! Number of unit cells within the supercell (determinant of the matrix).
93 : :
94 : : integer :: N1, N2, N3
95 : : ! Limits for canonical coordinates. N1*N2*N3=Ncells
96 : :
97 : : integer :: matrix(3,3)
98 : : ! Defines the supercell. Allows for non-diagonal supercells.
99 : :
100 : : real(dp) :: matrixT(3,3)
101 : : ! Transposed supercell matrix.
102 : :
103 : : real(dp) :: matrixinvT(3,3)
104 : : ! Inverse and Transposed supercell matrix.
105 : :
106 : : integer :: HH(3,3)
107 : : ! Hermite normal form of the supercell matrix.
108 : :
109 : : real(dp) :: rprimd(3,3)
110 : : ! Primitive vectors of the unit cell, in Bohr. Columns are the lattice vectors.
111 : :
112 : : real(dp) :: rprimdt(3,3)
113 : : ! Transposed primitive vectors of the unit cell, in Bohr.
114 : :
115 : : real(dp) :: rprimd_inv(3,3)
116 : : ! Inverse primitive vectors of the unit cell.
117 : :
118 : : real(dp) :: rprimd_scaled(3,3)
119 : : real(dp) :: rprimdt_scaled(3,3)
120 : : ! Primitive vectors of the supercell, in Bohr.
121 : :
122 : : real(dp) :: rprimd_scaled_inv(3,3)
123 : : ! Inverse primitive vectors of the supercell.
124 : :
125 : : real(dp) :: acell(3)
126 : : ! Cell parameters of the unit cell, in Bohr.
127 : :
128 : : real(dp), allocatable :: znucl(:)
129 : : ! znucl(ntypat)
130 : : ! Atomic numbers of each atom type.
131 : :
132 : : real(dp), allocatable :: xred_unitcell(:,:)
133 : : ! xred_unitcell(3,natom_unitcell)
134 : : ! Reduced coordinates of atoms expressed in the unitcell coordinate system.
135 : :
136 : : integer, allocatable :: typat_unitcell(:)
137 : : ! typat_unitcell(natom_unitcell)
138 : : ! Atom type in the unitcell.
139 : :
140 : : real(dp), allocatable :: R_red(:,:)
141 : : ! R_red(3, ncells)
142 : : ! Reduced coordinate of the lattice vectors of the unitcell
143 : : ! within the supercell.
144 : : ! This represents a particular choice for the supercell definition.
145 : :
146 : : integer, allocatable :: R_sh(:,:)
147 : : ! R_sh(3, natom)
148 : : ! An arbitrary supercell shift to apply to each atom.
149 : : ! Different atoms of the same unitcell may have different shifts
150 : : ! but the shift preserve canonical coordinates.
151 : :
152 : : real(dp), allocatable :: dij(:,:,:)
153 : : ! dij(natom, natom, 4)
154 : : ! Distance (dij(:,:,1)) and cartesian vector components (dij(:,:,2:4))
155 : : ! between every pair of atoms in the supercell,
156 : : ! using the minimum image convention.
157 : :
158 : : contains
159 : :
160 : : procedure :: init => supercell_init
161 : : ! Construct the object from the input definition.
162 : :
163 : : procedure :: free => supercell_free
164 : : ! Construct the object from the input definition.
165 : :
166 : : ! --------------------------
167 : :
168 : : procedure :: print => supercell_print
169 : : ! Write out supercell information.
170 : :
171 : : procedure :: write_xyz => supercell_write_xyz
172 : : ! Write out supercell in cartesian coordinates.
173 : :
174 : : procedure :: write_cif => supercell_write_cif
175 : : ! Write out supercell to a CIF file.
176 : :
177 : : ! --------------------------
178 : :
179 : : procedure :: modH => supercell_modH
180 : : ! Take the modulo with the superlattice.
181 : :
182 : : procedure :: is_mod0 => supercell_is_mod0
183 : : ! Is this vector modulo H equals to zero.
184 : :
185 : : procedure :: get_icell => supercell_get_icell
186 : : ! Get linear index of lattice vector.
187 : :
188 : : procedure :: get_Rcan => supercell_get_Rcan
189 : : !Get R_can from linear index.
190 : :
191 : : procedure :: get_iat_supercell => supercell_get_iat_supercell
192 : : ! Get supercell atom index from cell index and unitcell index.
193 : :
194 : : procedure :: get_iat_unitcell => supercell_get_iat_unitcell
195 : : ! Get cell index and unitcell index from supercell atom index.
196 : :
197 : : ! --------------------------
198 : :
199 : : procedure :: make_R_box => supercell_make_R_box
200 : : ! Create the list of lattice vectors.
201 : :
202 : : procedure :: get_R_at => supercell_get_R_at
203 : : ! Get the R vector corresponding to an atom.
204 : :
205 : : procedure :: set_R_at => supercell_set_R_at
206 : : ! Set the R vector of an atom.
207 : :
208 : : ! --------------------------
209 : : ! Coordinate transformations
210 : :
211 : : procedure :: cart_to_red => supercell_cart_to_red_unit
212 : : ! Transform from cartesian to reduced in the unitcell system of coordinate.
213 : :
214 : : procedure :: red_to_cart => supercell_red_unit_to_cart
215 : : ! Transform from reduced in the unitcell system of coordinate to cartesian.
216 : :
217 : : procedure :: cart_to_red_scaled => supercell_cart_to_red_scaled
218 : : ! Transform from cartesian to reduced in the supercell system of coordinate.
219 : :
220 : : procedure :: unit_to_scaled => supercell_unit_to_scaled
221 : : ! Transform from unit cell coordinates to scaled coordinates.
222 : :
223 : : procedure :: scaled_to_unit => supercell_scaled_to_unit
224 : : ! Transform from scaled coordinates to unit cell coordinates.
225 : :
226 : : procedure :: red_scaled_to_cart => supercell_red_scaled_to_cart
227 : : ! Transform from reduced in the supercell system of coordinate to cartesian.
228 : :
229 : : ! ------------------------
230 : :
231 : : procedure :: wrap_inbox => supercell_wrap_inbox
232 : : ! Wrap a vector in supercell-scaled reduced coordinates into [-0.5,0.5).
233 : :
234 : : procedure :: get_inbox_wrap => supercell_get_inbox_wrap
235 : : ! Find R shift that brings a R vector to [-0.5,0.5) in scaled coordinates.
236 : :
237 : : procedure :: make_box_centered => supercell_make_box_centered
238 : : ! Set all R_at so that scaled reduced coordinates fold into [-0.5,0.5).
239 : :
240 : : ! ------------------------
241 : :
242 : : procedure :: get_xred => supercell_get_xred_atom
243 : : ! Return the position of an atom in unitcell reduced coordinates.
244 : :
245 : : procedure :: get_xred_scaled => supercell_get_xred_scaled_atom
246 : : ! Return the position of an atom in supercell reduced coordinates.
247 : :
248 : : procedure :: get_xcart => supercell_get_xcart_atom
249 : : ! Return the position of an atom in cartesian coordinates.
250 : :
251 : : ! ------------------------
252 : :
253 : : procedure :: find_nearest_atom => supercell_find_nearest_atom
254 : : ! Get lattice vector from linear index.
255 : :
256 : : procedure :: atoms_distance => supercell_atoms_distance
257 : : ! Compute the distance between two atoms in the supercell.
258 : :
259 : : procedure :: calc_dij => supercell_calc_dij
260 : : ! Compute the distance and cartesian vector between all pairs of atoms
261 : : ! in the supercell, and store the result in SC%dij. Optional: call this
262 : : ! only if SC%dij is actually needed.
263 : :
264 : : end type tdep_Supercell_type
265 : : !!***
266 : :
267 : : contains
268 : : !!***
269 : :
270 : : !----------------------------------------------------------------------
271 : :
272 : : !!****f* m_tdep_supercell/normv
273 : : !! NAME
274 : : !! normv
275 : : !!
276 : : !! FUNCTION
277 : : !! Compute the Euclidean norm of a 3-component vector.
278 : : !!
279 : : !! INPUTS
280 : : !! xv(3)=input vector
281 : : !!
282 : : !! OUTPUT
283 : : !! res=norm of xv
284 : : !!
285 : : !! SOURCE
286 : :
287 : 2029807 : function normv(xv) result(res)
288 : : real(dp) :: res
289 : : real(dp),intent(in) :: xv(3)
290 : :
291 : 2029807 : res = SQRT(xv(1)**2 + xv(2)**2 + xv(3)**2)
292 : :
293 : 2029807 : end function normv
294 : : !!***
295 : :
296 : : !----------------------------------------------------------------------
297 : :
298 : : !!****f* m_tdep_supercell/supercell_init
299 : : !! NAME
300 : : !! supercell_init
301 : : !!
302 : : !! FUNCTION
303 : : !! Initialize the supercell object from a Crystal object describing the
304 : : !! unitcell, and the supercell matrix.
305 : : !!
306 : : !! INPUTS
307 : : !! Crystal=Crystal object describing the unitcell.
308 : : !! multiplicity(3,3)=supercell matrix (rounded to the nearest integers)
309 : : !! acell(3)=cell parameters of the unitcell, in Bohr.
310 : : !!
311 : : !! SIDE EFFECTS
312 : : !! SC=supercell object, allocated and filled on output
313 : : !!
314 : : !! SOURCE
315 : :
316 : 46 : subroutine supercell_init(SC,Crystal,multiplicity,acell)
317 : :
318 : : class(tdep_Supercell_type),intent(inout) :: SC
319 : : type(crystal_t), intent(in) :: Crystal
320 : : real(dp), intent(in) :: multiplicity(3,3) ! TODO Should be integer
321 : : real(dp), intent(in) :: acell(3)
322 : :
323 : : integer :: natom_unitcell
324 : : integer :: ii,jj
325 : : real(dp) :: rmatrix(3,3)
326 : :
327 : 46 : natom_unitcell = Crystal%natom
328 : 46 : SC%natom_unitcell = natom_unitcell
329 : 46 : SC%ntypat = Crystal%ntypat
330 : :
331 [ - + + - : 195 : ABI_CALLOC(SC%znucl, (SC%ntypat))
+ - + - -
+ - + - +
+ + ]
332 [ + + ]: 103 : SC%znucl(:) = Crystal%znucl(:)
333 : :
334 [ + + ]: 184 : SC%acell = acell
335 : :
336 [ + + + + ]: 598 : SC%rprimd = Crystal%rprimd
337 [ + + + + : 1150 : SC%rprimdt = transpose(SC%rprimd)
+ + + + ]
338 : 46 : call matr3inv(SC%rprimdt, SC%rprimd_inv)
339 : :
340 [ - + + - : 578 : ABI_CALLOC(SC%xred_unitcell,(3,natom_unitcell))
+ - + - -
+ - + - +
+ + + + ]
341 [ - + + - : 248 : ABI_CALLOC(SC%typat_unitcell,(natom_unitcell))
+ - + - -
+ - + - +
+ + ]
342 [ + + + + ]: 486 : SC%xred_unitcell(:,:) = Crystal%xred(:,:)
343 [ + + ]: 156 : SC%typat_unitcell(:) = Crystal%typat(:)
344 : :
345 : : ! Round multiplicity to nearest integers
346 [ + + ]: 184 : do ii=1,3
347 [ + + ]: 598 : do jj=1,3
348 : 552 : SC%matrix(ii, jj) = NINT(multiplicity(ii,jj))
349 : : end do
350 : : end do
351 : :
352 : : ! Compute supercell vectors
353 [ + + + + : 2944 : SC%rprimdt_scaled = matmul(SC%matrix, SC%rprimdt)
+ + + + +
+ + + +
+ ]
354 [ + + + + : 1150 : SC%rprimd_scaled = transpose(SC%rprimdt_scaled)
+ + + + ]
355 : 46 : call matr3inv(SC%rprimdt_scaled, SC%rprimd_scaled_inv)
356 : :
357 : : ! Compute number of primitive cells in the supercell
358 : 46 : call mati3det(SC%matrix, SC%Ncells)
359 : :
360 : : ! Compute inverse matrix
361 [ + + + + ]: 598 : rmatrix = REAL(SC%matrix, KIND=dp)
362 : 46 : call matr3inv(rmatrix, SC%matrixinvT)
363 [ + + + + ]: 598 : SC%matrixT = transpose(rmatrix)
364 : :
365 : : ! Compute Hermite normal form
366 : 46 : call mati3HNF(SC%matrix, SC%HH)
367 : :
368 : : ! Save limits
369 : 46 : SC%N1 = SC%HH(1,1); SC%N2 = SC%HH(2,2); SC%N3 = SC%HH(3,3);
370 : 46 : SC%natom = SC%Ncells * SC%natom_unitcell
371 : :
372 : : ! ------------------------------------
373 : :
374 : : ! Construct supercell box containing all different canonical vectors.
375 [ - + + - : 138 : ABI_MALLOC(SC%R_red, (3,SC%Ncells))
+ - + - -
+ - + -
+ ]
376 : 46 : call SC%make_R_box()
377 : :
378 : : ! Finally, set up R_sh so that atoms wrap in centered unit cell.
379 [ - + + - : 29250 : ABI_CALLOC(SC%R_sh, (3,SC%natom))
+ - + - -
+ - + - +
+ + + + ]
380 : 46 : call SC%make_box_centered()
381 : :
382 : 46 : end subroutine supercell_init
383 : : !!***
384 : :
385 : : !----------------------------------------------------------------------
386 : :
387 : : !!****f* m_tdep_supercell/supercell_free
388 : : !! NAME
389 : : !! supercell_free
390 : : !!
391 : : !! FUNCTION
392 : : !! Free the memory allocated in the supercell object.
393 : : !!
394 : : !! SIDE EFFECTS
395 : : !! SC=supercell object, deallocated on output
396 : : !!
397 : : !! SOURCE
398 : :
399 : 46 : subroutine supercell_free(SC)
400 : :
401 : : class(tdep_Supercell_type),intent(inout) :: SC
402 : :
403 [ + - ]: 46 : ABI_SFREE(SC%xred_unitcell)
404 [ + - ]: 46 : ABI_SFREE(SC%typat_unitcell)
405 [ + - ]: 46 : ABI_SFREE(SC%znucl)
406 [ + - ]: 46 : ABI_SFREE(SC%R_red)
407 [ + - ]: 46 : ABI_SFREE(SC%R_sh)
408 [ + - ]: 46 : ABI_SFREE(SC%dij)
409 : :
410 : 46 : end subroutine supercell_free
411 : : !!***
412 : :
413 : : !----------------------------------------------------------------------
414 : :
415 : : !!****f* m_tdep_supercell/supercell_print
416 : : !! NAME
417 : : !! supercell_print
418 : : !!
419 : : !! FUNCTION
420 : : !! Write out supercell information to a file.
421 : : !!
422 : : !! INPUTS
423 : : !! iout=output unit number
424 : : !!
425 : : !! SOURCE
426 : :
427 : 46 : subroutine supercell_print(SC,iout)
428 : :
429 : : class(tdep_Supercell_type),intent(in) :: SC
430 : : integer, intent(in) :: iout
431 : :
432 : : logical :: debug = .false.
433 : : integer :: ii,jj,icell
434 : : integer :: RR(3)
435 : : integer :: Rcan(3)
436 : :
437 : 46 : write(iout,'(a)') '===================================================='
438 : 46 : write(iout,'(a)') '--------------- Supercell definition ---------------'
439 : 46 : write(iout,'(a)') '----------------------------------------------------'
440 : 46 : write(iout,'(a)') 'Unit cell'
441 : 46 : write(iout,'(a)') '---------'
442 : 46 : write(iout,'(a)') 'Primitive vectors of the unit cell'
443 [ + + ]: 184 : do ii=1,3
444 [ + - + + ]: 598 : write(iout,'(24x,3(f15.10,1x))') (SC%rprimdt(ii,jj),jj=1,3)
445 : : end do
446 : 46 : write(iout,'(a)') 'Supercell vectors '
447 [ + + ]: 184 : do ii=1,3
448 [ + - + + ]: 598 : write(iout,'(24x,3(f15.10,1x))') (SC%rprimdt_scaled(ii,jj),jj=1,3)
449 : : end do
450 : : !write(iout,'(a)') 'natom_unitcell ',SC%natom_unitcell
451 : :
452 : 46 : write(iout,'(a)') 'Supercell matrix'
453 [ + + ]: 184 : do ii=1,3
454 : 184 : write(iout,'(24x,3i6)') SC%matrix(ii,:)
455 : : end do
456 : :
457 : 46 : write(iout,'(a)') 'Hermite Normal Form'
458 [ + + ]: 184 : do ii=1,3
459 : 184 : write(iout,'(24x,3i6)') SC%HH(ii,:)
460 : : end do
461 : :
462 : 46 : write(iout,'(a)') 'Number of cells'
463 : 46 : write(iout,'(24x,i6)') SC%Ncells
464 : :
465 : : !write(iout,'(a)') 'Lattice vectors in reduced coordinates w.r.t. primitive cell'
466 : : !do icell=1,SC%Ncells
467 : : ! RR(:) = SC%R_red(:,icell)
468 : : ! write(iout,'(8x,i8,8x,3i6)') icell, (RR(ii), ii=1,3)
469 : : !end do
470 : :
471 [ - + ]: 46 : if (debug) then
472 : :
473 : 0 : write(std_out,'(a)') '------------------------------'
474 : 0 : write(std_out,'(a)') 'Lattice vectors in reduced coordinates and canonical coordinates'
475 [ # # ]: 0 : do icell=1,SC%Ncells
476 : 0 : write(std_out, '(a)') '---------'
477 [ # # ]: 0 : RR(:) = SC%R_red(:,icell)
478 [ # # ]: 0 : Rcan = SC%modH(RR)
479 : 0 : write(std_out, *) 'icell =',icell
480 : 0 : write(std_out, *) 'R_red =',RR
481 : 0 : write(std_out, *) 'Rcan =',Rcan
482 : 0 : jj = SC%get_icell(RR)
483 : 0 : write(std_out, *) 'jcell =',jj
484 : 0 : write(std_out, '(a)') '---------'
485 : : end do
486 : 0 : write(std_out, '(a)') '------------------------------'
487 : : end if
488 : :
489 : 46 : write(iout,'(a)') '----------------------------------------------------'
490 : :
491 : 46 : end subroutine supercell_print
492 : : !!***
493 : :
494 : : !----------------------------------------------------------------------
495 : :
496 : : !!****f* m_tdep_supercell/supercell_make_R_box
497 : : !! NAME
498 : : !! supercell_make_R_box
499 : : !!
500 : : !! FUNCTION
501 : : !! Build the list of lattice vectors R_red forming a compact box
502 : : !! around the origin, one per canonical coordinate.
503 : : !!
504 : : !! SIDE EFFECTS
505 : : !! SC=supercell object, R_red is filled on output
506 : : !!
507 : : !! SOURCE
508 : :
509 : 46 : subroutine supercell_make_R_box(SC)
510 : :
511 : : class(tdep_Supercell_type),intent(inout) :: SC
512 : :
513 : : integer :: icell
514 : : integer :: ii,jj,kk
515 : : integer :: di,dj,dk
516 : : integer :: Rred(3)
517 : : integer :: R_try(3)
518 : : integer :: T_try(3)
519 : : integer :: Ht(3,3)
520 : : real(dp) :: Rcan(3)
521 : : real(dp) :: Rcart(3), Rcan_cart(3)
522 : : real(dp) :: H1(3),H2(3),H3(3)
523 : : real(dp) :: R1(3),R2(3),R3(3)
524 : : real(dp) :: Rnorm, Rnorm_sm
525 : :
526 [ + + + + ]: 598 : Ht = transpose(SC%HH)
527 [ + + ]: 184 : H1 = REAL(SC%HH(1,:))
528 [ + + ]: 184 : H2 = REAL(SC%HH(2,:))
529 [ + + ]: 184 : H3 = REAL(SC%HH(3,:))
530 : 46 : R1 = SC%red_to_cart(H1)
531 : 46 : R2 = SC%red_to_cart(H2)
532 : 46 : R3 = SC%red_to_cart(H3)
533 : :
534 : :
535 [ + + + + ]: 17018 : SC%R_red(:,:) = zero
536 : :
537 : 46 : icell = 0
538 [ + + ]: 311 : do kk=0,SC%N3-1
539 [ + + ]: 1772 : do jj=0,SC%N2-1
540 [ + + ]: 5969 : do ii=0,SC%N1-1
541 : :
542 : 4243 : icell = icell+1
543 [ + + ]: 4243 : if (icell == 1) cycle ! Origin
544 : :
545 [ + + ]: 16788 : Rcan(:) = (/ii, jj, kk/)
546 : :
547 [ + + - + ]: 16788 : Rcan_cart = SC%red_to_cart(real(Rcan,kind=dp))
548 : :
549 : 4197 : Rnorm_sm = greatest_real
550 : 4197 : Rred = zero
551 : :
552 [ + + ]: 16788 : do di = 1,-1,-1
553 [ + + ]: 54561 : do dj = 1,-1,-1
554 [ + + ]: 163683 : do dk = 1,-1,-1
555 [ + + ]: 453276 : T_try(:) = (/di, dj, dk/)
556 [ + + + + : 1813104 : R_try(:) = Rcan(:) + matmul(Ht, T_try)
+ + ]
557 [ + + - + : 906552 : Rcart = SC%red_to_cart(real(R_try,kind=dp))
+ + ]
558 : :
559 : 113319 : Rnorm = normv(Rcart)
560 : :
561 : : ! The tol12 margin discriminates symmetry-equivalent R vectors,
562 [ + + ]: 151092 : if (Rnorm < Rnorm_sm - tol12) then
563 : 30551 : Rnorm_sm = Rnorm
564 : 30551 : Rred = R_try
565 : : end if
566 : :
567 : : end do
568 : : end do
569 : : end do
570 : :
571 [ + + ]: 18249 : SC%R_red(:,icell) = Rred(:)
572 : :
573 : : end do
574 : : end do
575 : : end do
576 : :
577 : 46 : end subroutine supercell_make_R_box
578 : : !!***
579 : :
580 : : !----------------------------------------------------------------------
581 : :
582 : : !!****f* m_tdep_supercell/supercell_write_xyz
583 : : !! NAME
584 : : !! supercell_write_xyz
585 : : !!
586 : : !! FUNCTION
587 : : !! Write the ideal supercell atomic positions to an XYZ file, in cartesian coordinates.
588 : : !!
589 : : !! INPUTS
590 : : !! prefix=prefix of the output file name
591 : : !!
592 : : !! SOURCE
593 : :
594 : 0 : subroutine supercell_write_xyz(SC,prefix)
595 : : class(tdep_Supercell_type),intent(in) :: SC
596 : : character(len=fnlen), intent(in) :: prefix
597 : :
598 : : integer :: unt
599 : : integer :: iatom,icell,iat_unit
600 : : real(dp) :: xcart(3)
601 : :
602 : 0 : unt = get_unit()
603 : 0 : open(unit=unt,file=trim(prefix)//'_xcart_ideal.xyz')
604 : 0 : write(unt,'(a1,1x,a8,4x,a6,4x,3(a5,30x))') '#', 'xcart', 'iatom', 'icell', 'iat_unitcell'
605 : 0 : write(unt,'(a)')''
606 : :
607 [ # # ]: 0 : do iatom=1,SC%natom
608 : :
609 [ # # ]: 0 : xcart = SC%get_xcart(iatom)
610 : 0 : call SC%get_iat_unitcell(iatom, icell, iat_unit)
611 : :
612 : 0 : write(unt,'(2x,3(f10.6,1x),4x,3(i6,2x))') xcart, iatom, icell, iat_unit
613 : 0 : write(unt,'(a)')''
614 : :
615 : : end do
616 : :
617 : 0 : close(unt)
618 : :
619 : 0 : end subroutine supercell_write_xyz
620 : : !!***
621 : :
622 : : !----------------------------------------------------------------------
623 : :
624 : : !!****f* m_tdep_supercell/supercell_write_cif
625 : : !! NAME
626 : : !! supercell_write_cif
627 : : !!
628 : : !! FUNCTION
629 : : !! Write the ideal supercell (including R_sh shifts) to a CIF file.
630 : : !! znucl(ntypat) is used to resolve atomic numbers into element symbols.
631 : : !!
632 : : !! INPUTS
633 : : !! prefix=prefix of the output file name
634 : : !!
635 : : !! SOURCE
636 : :
637 : 46 : subroutine supercell_write_cif(SC,prefix)
638 : : class(tdep_Supercell_type),intent(in) :: SC
639 : : character(len=fnlen), intent(in) :: prefix
640 : :
641 : : integer :: unt
642 : : integer :: iatom,icell,iat_unit
643 : : real(dp) :: aa,bb,cc,alpha,beta,gamma_,ZZ
644 : : real(dp) :: r1(3),r2(3),r3(3)
645 : : real(dp) :: xred_unit(3),xred_scaled(3)
646 : : character(len=2) :: symbol
647 : : character(len=16) :: label
648 : :
649 [ + + ]: 184 : r1(:) = SC%rprimdt_scaled(1,:)
650 [ + + ]: 184 : r2(:) = SC%rprimdt_scaled(2,:)
651 [ + + ]: 184 : r3(:) = SC%rprimdt_scaled(3,:)
652 : :
653 : 46 : aa = normv(r1)
654 : 46 : bb = normv(r2)
655 : 46 : cc = normv(r3)
656 : :
657 [ + + ]: 184 : alpha = ACOS(dot_product(r2,r3) / (bb*cc)) * 180.0_dp / pi
658 [ + + ]: 184 : beta = ACOS(dot_product(r1,r3) / (aa*cc)) * 180.0_dp / pi
659 [ + + ]: 184 : gamma_= ACOS(dot_product(r1,r2) / (aa*bb)) * 180.0_dp / pi
660 : :
661 : 46 : unt = get_unit()
662 : 46 : open(unit=unt,file=trim(prefix)//'_supercell.cif')
663 : :
664 : 46 : write(unt,'(a)') 'data_supercell'
665 : 46 : write(unt,'(a,f14.8)') '_cell_length_a ', aa*Bohr_Ang
666 : 46 : write(unt,'(a,f14.8)') '_cell_length_b ', bb*Bohr_Ang
667 : 46 : write(unt,'(a,f14.8)') '_cell_length_c ', cc*Bohr_Ang
668 : 46 : write(unt,'(a,f14.8)') '_cell_angle_alpha ', alpha
669 : 46 : write(unt,'(a,f14.8)') '_cell_angle_beta ', beta
670 : 46 : write(unt,'(a,f14.8)') '_cell_angle_gamma ', gamma_
671 : 46 : write(unt,'(a)') "_symmetry_space_group_name_H-M 'P 1'"
672 : 46 : write(unt,'(a)') '_symmetry_Int_Tables_number 1'
673 : 46 : write(unt,'(a)') 'loop_'
674 : 46 : write(unt,'(a)') '_atom_site_label'
675 : 46 : write(unt,'(a)') '_atom_site_type_symbol'
676 : 46 : write(unt,'(a)') '_atom_site_fract_x'
677 : 46 : write(unt,'(a)') '_atom_site_fract_y'
678 : 46 : write(unt,'(a)') '_atom_site_fract_z'
679 : :
680 [ + + ]: 7324 : do iatom=1,SC%natom
681 : :
682 : 7278 : call SC%get_iat_unitcell(iatom, icell, iat_unit)
683 : :
684 : 7278 : ZZ = SC%znucl(SC%typat_unitcell(iat_unit))
685 : 7278 : symbol = adjustl(znucl2symbol(ZZ))
686 : :
687 : 7278 : write(label,'(a,i0)') trim(symbol), iatom
688 : :
689 [ + + ]: 29112 : xred_unit = SC%get_xred(iatom)
690 [ + + ]: 29112 : xred_scaled = SC%unit_to_scaled(xred_unit)
691 : :
692 : 14602 : write(unt,'(a8,2x,a2,2x,3(f12.8,1x))') label, symbol, xred_scaled
693 : :
694 : : end do
695 : :
696 : 46 : close(unt)
697 : :
698 : 46 : end subroutine supercell_write_cif
699 : : !!***
700 : :
701 : : !----------------------------------------------------------------------
702 : :
703 : : !!****f* m_tdep_supercell/supercell_modH
704 : : !! NAME
705 : : !! supercell_modH
706 : : !!
707 : : !! FUNCTION
708 : : !! Take the modulo of a lattice vector RR with respect to the supercell
709 : : !! matrix, achieving the unique decomposition RR = (H * t) + Rcan,
710 : : !! where t(3) is an integer vector.
711 : : !!
712 : : !! INPUTS
713 : : !! RR(3)=lattice vector, in reduced coordinates
714 : : !!
715 : : !! OUTPUT
716 : : !! Rcan(3)=canonical lattice vector, RR modulo H
717 : : !!
718 : : !! SOURCE
719 : :
720 [ - + ]: 21834 : function supercell_modH(SC,RR) result(Rcan)
721 : :
722 : : class(tdep_Supercell_type),intent(in) :: SC
723 : : integer, intent(in) :: RR(3)
724 : : integer :: Rcan(3)
725 : :
726 : : integer :: tt(3)
727 : : integer :: H11,H22,H33,H12,H13,H23
728 : :
729 : 21834 : H11=SC%HH(1,1); H22=SC%HH(2,2); H33=SC%HH(3,3);
730 : 21834 : H12=SC%HH(1,2); H13=SC%HH(1,3); H23=SC%HH(2,3);
731 : :
732 : 21834 : Rcan(1) = modulo(RR(1), H11)
733 : 21834 : tt(1) = (RR(1) - Rcan(1)) / H11
734 : :
735 : 21834 : Rcan(2) = modulo(RR(2) - H12*tt(1), H22)
736 : 21834 : tt(2) = (RR(2) - H12*tt(1) - Rcan(2)) / H22
737 : :
738 : 21834 : Rcan(3) = modulo(RR(3) - H13*tt(1) - H23*tt(2), H33)
739 : 21834 : tt(3) = (RR(3) - H13*tt(1) - H23*tt(2) - Rcan(3)) / H33
740 : :
741 : 21834 : end function supercell_modH
742 : : !!***
743 : :
744 : : !----------------------------------------------------------------------
745 : :
746 : : !!****f* m_tdep_supercell/supercell_is_mod0
747 : : !! NAME
748 : : !! supercell_is_mod0
749 : : !!
750 : : !! FUNCTION
751 : : !! Check whether a lattice vector is equivalent to zero modulo the supercell matrix.
752 : : !!
753 : : !! INPUTS
754 : : !! RR(3)=lattice vector, in reduced coordinates
755 : : !!
756 : : !! OUTPUT
757 : : !! is_mod0=.true. if modH(RR) is zero
758 : : !!
759 : : !! SOURCE
760 : :
761 : 7278 : function supercell_is_mod0(SC,RR) result(is_mod0)
762 : : class(tdep_Supercell_type),intent(in) :: SC
763 : : integer,intent(in) :: RR(3)
764 : : logical :: is_mod0
765 : : integer :: ii
766 : : integer :: Rmod(3)
767 : :
768 [ + + ]: 29112 : Rmod = SC%modH(RR)
769 : 7278 : is_mod0 = .true.
770 [ + + ]: 29112 : do ii=1,3
771 [ - + ]: 29112 : if (Rmod(ii).ne.0) is_mod0 =.false.
772 : : end do
773 : :
774 : 7278 : end function supercell_is_mod0
775 : : !!***
776 : :
777 : : !----------------------------------------------------------------------
778 : :
779 : : !!****f* m_tdep_supercell/supercell_get_icell
780 : : !! NAME
781 : : !! supercell_get_icell
782 : : !!
783 : : !! FUNCTION
784 : : !! Get the linear cell index corresponding to a lattice vector.
785 : : !!
786 : : !! INPUTS
787 : : !! RR(3)=lattice vector, in reduced coordinates
788 : : !!
789 : : !! OUTPUT
790 : : !! icell=linear index of the cell containing RR
791 : : !!
792 : : !! SOURCE
793 : :
794 : 7278 : function supercell_get_icell(SC,RR) result(icell)
795 : : class(tdep_Supercell_type),intent(in) :: SC
796 : : integer, intent(in) :: RR(3)
797 : : integer :: icell
798 : : integer :: Rcan(3)
799 [ + + ]: 29112 : Rcan = SC%modH(RR)
800 : 7278 : icell = 1 + Rcan(1) + Rcan(2) * SC%N1 + Rcan(3) * SC%N2 * SC%N1
801 : 7278 : end function supercell_get_icell
802 : : !!***
803 : :
804 : : !----------------------------------------------------------------------
805 : :
806 : : !!****f* m_tdep_supercell/supercell_get_Rcan
807 : : !! NAME
808 : : !! supercell_get_Rcan
809 : : !!
810 : : !! FUNCTION
811 : : !! Get the canonical lattice vector corresponding to a linear cell index.
812 : : !!
813 : : !! INPUTS
814 : : !! icell=linear index of the cell
815 : : !!
816 : : !! OUTPUT
817 : : !! Rcan(3)=canonical lattice vector
818 : : !!
819 : : !! SOURCE
820 : :
821 [ # # ]: 0 : function supercell_get_Rcan(SC,icell) result(Rcan)
822 : : class(tdep_Supercell_type),intent(in) :: SC
823 : : integer, intent(in) :: icell
824 : : integer :: Rcan(3)
825 : : integer :: ii,jj,kk
826 : : integer :: idx
827 : 0 : idx = icell - 1
828 : 0 : ii = mod(idx, SC%N1)
829 : 0 : jj = mod((idx-ii)/SC%N1, SC%N2)
830 : 0 : kk = ((idx-ii)/SC%N1 - jj) / SC%N2 ! i.e. remainder after removing ii and jj
831 [ # # ]: 0 : Rcan(:) = (/ii, jj, kk/)
832 : 0 : end function supercell_get_Rcan
833 : : !!***
834 : :
835 : : !----------------------------------------------------------------------
836 : :
837 : : !!****f* m_tdep_supercell/supercell_get_R_at
838 : : !! NAME
839 : : !! supercell_get_R_at
840 : : !!
841 : : !! FUNCTION
842 : : !! Get the lattice vector R associated with an atom of the supercell.
843 : : !!
844 : : !! INPUTS
845 : : !! iat_super=index of the atom in the supercell
846 : : !!
847 : : !! OUTPUT
848 : : !! R_at(3)=lattice vector of the atom
849 : : !!
850 : : !! SOURCE
851 : :
852 [ - + ]: 14556 : function supercell_get_R_at(SC, iat_super) result(R_at)
853 : : class(tdep_Supercell_type),intent(in) :: SC
854 : : integer, intent(in) :: iat_super
855 : : integer :: icell, iat_unit
856 : : integer :: R_at(3)
857 : 14556 : call SC%get_iat_unitcell(iat_super, icell, iat_unit)
858 [ + + ]: 58224 : R_at = SC%R_red(:,icell) + SC%R_sh(:,iat_super)
859 : 14556 : end function supercell_get_R_at
860 : : !!***
861 : :
862 : : !----------------------------------------------------------------------
863 : :
864 : : !!****f* m_tdep_supercell/supercell_get_iat_supercell
865 : : !! NAME
866 : : !! supercell_get_iat_supercell
867 : : !!
868 : : !! FUNCTION
869 : : !! Get the supercell atom index from the cell index and the unitcell atom index.
870 : : !!
871 : : !! INPUTS
872 : : !! icell=linear index of the cell
873 : : !! iat_unit=index of the atom in the unit cell
874 : : !!
875 : : !! OUTPUT
876 : : !! iat_super=index of the atom in the supercell
877 : : !!
878 : : !! SOURCE
879 : :
880 : 30280 : function supercell_get_iat_supercell(SC,icell,iat_unit) result(iat_super)
881 : : class(tdep_Supercell_type),intent(in) :: SC
882 : : integer, intent(in) :: icell
883 : : integer, intent(in) :: iat_unit
884 : : integer :: iat_super
885 : :
886 : 30280 : iat_super = iat_unit + (icell - 1) * SC%natom_unitcell
887 : :
888 : 30280 : end function supercell_get_iat_supercell
889 : : !!***
890 : :
891 : : !----------------------------------------------------------------------
892 : :
893 : : !!****f* m_tdep_supercell/supercell_get_iat_unitcell
894 : : !! NAME
895 : : !! supercell_get_iat_unitcell
896 : : !!
897 : : !! FUNCTION
898 : : !! Get the cell index and the unitcell atom index from the supercell atom index.
899 : : !!
900 : : !! INPUTS
901 : : !! iat_super=index of the atom in the supercell
902 : : !!
903 : : !! OUTPUT
904 : : !! icell=linear index of the cell
905 : : !! iat_unit=index of the atom in the unit cell
906 : : !!
907 : : !! SOURCE
908 : :
909 : 116523156 : subroutine supercell_get_iat_unitcell(SC,iat_super,icell,iat_unit)
910 : : class(tdep_Supercell_type),intent(in) :: SC
911 : : integer, intent(in) :: iat_super
912 : : integer, intent(out) :: icell
913 : : integer, intent(out) :: iat_unit
914 : :
915 : 116523156 : iat_unit = 1 + modulo(iat_super - 1, SC%natom_unitcell)
916 : 116523156 : icell = 1 + (iat_super - iat_unit) / SC%natom_unitcell
917 : :
918 : 116523156 : end subroutine supercell_get_iat_unitcell
919 : : !!***
920 : :
921 : : !----------------------------------------------------------------------
922 : :
923 : : !!****f* m_tdep_supercell/supercell_red_unit_to_cart
924 : : !! NAME
925 : : !! supercell_red_unit_to_cart
926 : : !!
927 : : !! FUNCTION
928 : : !! Transform from unitcell reduced coordinates to cartesian coordinates.
929 : : !!
930 : : !! INPUTS
931 : : !! xred(3)=position, in unitcell reduced coordinates
932 : : !!
933 : : !! OUTPUT
934 : : !! xcart(3)=position, in cartesian coordinates
935 : : !!
936 : : !! SOURCE
937 : :
938 [ - + ]: 495954 : function supercell_red_unit_to_cart(SC,xred) result(xcart)
939 : : class(tdep_Supercell_type),intent(in) :: SC
940 : : real(dp), intent(in) :: xred(3)
941 : : real(dp) :: xcart(3)
942 [ + + + + : 8431218 : xcart = matmul(SC%rprimd, xred)
+ + ]
943 : 495954 : end function supercell_red_unit_to_cart
944 : : !!***
945 : :
946 : : !----------------------------------------------------------------------
947 : :
948 : : !!****f* m_tdep_supercell/supercell_cart_to_red_unit
949 : : !! NAME
950 : : !! supercell_cart_to_red_unit
951 : : !!
952 : : !! FUNCTION
953 : : !! Transform from cartesian coordinates to unitcell reduced coordinates.
954 : : !!
955 : : !! INPUTS
956 : : !! xcart(3)=position, in cartesian coordinates
957 : : !!
958 : : !! OUTPUT
959 : : !! xred(3)=position, in unitcell reduced coordinates
960 : : !!
961 : : !! SOURCE
962 : :
963 [ - + ]: 7278 : function supercell_cart_to_red_unit(SC,xcart) result(xred)
964 : : class(tdep_Supercell_type),intent(in) :: SC
965 : : real(dp), intent(in) :: xcart(3)
966 : : real(dp) :: xred(3)
967 [ + + + + : 123726 : xred = matmul(SC%rprimd_inv, xcart)
+ + ]
968 : 7278 : end function supercell_cart_to_red_unit
969 : : !!***
970 : :
971 : : !----------------------------------------------------------------------
972 : :
973 : : !!****f* m_tdep_supercell/supercell_cart_to_red_scaled
974 : : !! NAME
975 : : !! supercell_cart_to_red_scaled
976 : : !!
977 : : !! FUNCTION
978 : : !! Transform from cartesian coordinates to supercell reduced coordinates.
979 : : !!
980 : : !! INPUTS
981 : : !! xcart(3)=position, in cartesian coordinates
982 : : !!
983 : : !! OUTPUT
984 : : !! xred(3)=position, in supercell reduced coordinates
985 : : !!
986 : : !! SOURCE
987 : :
988 [ # # ]: 0 : function supercell_cart_to_red_scaled(SC,xcart) result(xred)
989 : : class(tdep_Supercell_type),intent(in) :: SC
990 : : real(dp), intent(in) :: xcart(3)
991 : : real(dp) :: xred(3)
992 [ # # # # : 0 : xred = matmul(SC%rprimd_scaled_inv, xcart)
# # ]
993 : 0 : end function supercell_cart_to_red_scaled
994 : : !!***
995 : :
996 : : !----------------------------------------------------------------------
997 : :
998 : : !!****f* m_tdep_supercell/supercell_unit_to_scaled
999 : : !! NAME
1000 : : !! supercell_unit_to_scaled
1001 : : !!
1002 : : !! FUNCTION
1003 : : !! Transform from unitcell reduced coordinates to supercell reduced coordinates.
1004 : : !!
1005 : : !! INPUTS
1006 : : !! xred_unit(3)=position, in unitcell reduced coordinates
1007 : : !!
1008 : : !! OUTPUT
1009 : : !! xred_scaled(3)=position, in supercell reduced coordinates
1010 : : !!
1011 : : !! SOURCE
1012 : :
1013 [ - + ]: 116488054 : function supercell_unit_to_scaled(SC,xred_unit) result(xred_scaled)
1014 : : class(tdep_Supercell_type),intent(in) :: SC
1015 : : real(dp), intent(in) :: xred_unit(3)
1016 : : real(dp) :: xred_scaled(3)
1017 [ + + + + : 1980296918 : xred_scaled = matmul(SC%matrixinvT, xred_unit)
+ + ]
1018 : 116488054 : end function supercell_unit_to_scaled
1019 : : !!***
1020 : :
1021 : : !----------------------------------------------------------------------
1022 : :
1023 : : !!****f* m_tdep_supercell/supercell_scaled_to_unit
1024 : : !! NAME
1025 : : !! supercell_scaled_to_unit
1026 : : !!
1027 : : !! FUNCTION
1028 : : !! Transform from supercell reduced coordinates to unitcell reduced coordinates.
1029 : : !!
1030 : : !! INPUTS
1031 : : !! xred_scaled(3)=position, in supercell reduced coordinates
1032 : : !!
1033 : : !! OUTPUT
1034 : : !! xred_unit(3)=position, in unitcell reduced coordinates
1035 : : !!
1036 : : !! SOURCE
1037 : :
1038 [ - + ]: 93612769 : function supercell_scaled_to_unit(SC,xred_scaled) result(xred_unit)
1039 : : class(tdep_Supercell_type),intent(in) :: SC
1040 : : real(dp), intent(in) :: xred_scaled(3)
1041 : : real(dp) :: xred_unit(3)
1042 [ + + + + : 1591417073 : xred_unit = matmul(SC%matrixT, xred_scaled)
+ + ]
1043 : 93612769 : end function supercell_scaled_to_unit
1044 : : !!***
1045 : :
1046 : : !----------------------------------------------------------------------
1047 : :
1048 : : !!****f* m_tdep_supercell/supercell_red_scaled_to_cart
1049 : : !! NAME
1050 : : !! supercell_red_scaled_to_cart
1051 : : !!
1052 : : !! FUNCTION
1053 : : !! Transform from supercell reduced coordinates to cartesian coordinates.
1054 : : !!
1055 : : !! INPUTS
1056 : : !! xred(3)=position, in supercell reduced coordinates
1057 : : !!
1058 : : !! OUTPUT
1059 : : !! xcart(3)=position, in cartesian coordinates
1060 : : !!
1061 : : !! SOURCE
1062 : :
1063 [ - + ]: 1728670 : function supercell_red_scaled_to_cart(SC,xred) result(xcart)
1064 : : class(tdep_Supercell_type),intent(in) :: SC
1065 : : real(dp), intent(in) :: xred(3)
1066 : : real(dp) :: xcart(3)
1067 [ + + + + : 29387390 : xcart = matmul(SC%rprimd_scaled, xred)
+ + ]
1068 : 1728670 : end function supercell_red_scaled_to_cart
1069 : : !!***
1070 : :
1071 : : !----------------------------------------------------------------------
1072 : :
1073 : : !!****f* m_tdep_supercell/supercell_wrap_inbox
1074 : : !! NAME
1075 : : !! supercell_wrap_inbox
1076 : : !!
1077 : : !! FUNCTION
1078 : : !! Wrap a vector expressed in supercell reduced coordinates into [-0.5,0.5),
1079 : : !! component-wise. Mirrors tdep_make_inbox; matches the minimum-image
1080 : : !! convention used in m_ifc.
1081 : : !!
1082 : : !! INPUTS
1083 : : !! xred_scaled(3)=position, in supercell reduced coordinates
1084 : : !!
1085 : : !! OUTPUT
1086 : : !! xred_wrap(3)=position, wrapped into [-0.5,0.5)
1087 : : !!
1088 : : !! SOURCE
1089 [ - + ]: 93591863 : function supercell_wrap_inbox(SC,xred_scaled) result(xred_wrap)
1090 : : class(tdep_Supercell_type),intent(in) :: SC
1091 : : real(dp), intent(in) :: xred_scaled(3)
1092 : : real(dp) :: xred_wrap(3)
1093 : : real(dp) :: R_shift(3)
1094 : : integer :: nn
1095 : :
1096 : 93591863 : nn = SC%ncells ! For abirules
1097 [ + + ]: 374367452 : call wrap2_pmhalf(xred_scaled, xred_wrap, R_shift)
1098 : :
1099 : 93591863 : end function supercell_wrap_inbox
1100 : : !!***
1101 : :
1102 : : !----------------------------------------------------------------------
1103 : :
1104 : : !!****f* m_tdep_supercell/supercell_get_inbox_wrap
1105 : : !! NAME
1106 : : !! supercell_get_inbox_wrap
1107 : : !!
1108 : : !! FUNCTION
1109 : : !! Find the lattice vector shift R_shift such that R_at - R_shift lies
1110 : : !! inside the [-0.5,0.5) box, in supercell reduced coordinates.
1111 : : !!
1112 : : !! INPUTS
1113 : : !! iat_super=index of the atom in the supercell
1114 : : !!
1115 : : !! OUTPUT
1116 : : !! R_shift(3)=lattice vector shift, in unitcell reduced coordinates
1117 : : !! R_shift_scaled(3)=lattice vector shift, in supercell reduced coordinates
1118 : : !!
1119 : : !! SOURCE
1120 : :
1121 : 7278 : subroutine supercell_get_inbox_wrap(SC,iat_super,R_shift,R_shift_scaled)
1122 : :
1123 : : class(tdep_Supercell_type),intent(in) :: SC
1124 : : integer, intent(in) :: iat_super
1125 : : integer, intent(out) :: R_shift(3)
1126 : : real(dp), intent(out) :: R_shift_scaled(3)
1127 : : real(dp) :: xred_unit(3), xred_scaled(3), xred_wrap(3)
1128 : :
1129 : : ! Fold into [-0.5,0.5) and determine the (integer) shift that was added..
1130 [ + + ]: 29112 : xred_unit = SC%get_xred(iat_super)
1131 [ + + ]: 29112 : xred_scaled = SC%unit_to_scaled(xred_unit)
1132 [ + + ]: 29112 : call wrap2_pmhalf(xred_scaled, xred_wrap, R_shift_scaled)
1133 : :
1134 [ + + ]: 29112 : R_shift = NINT(SC%scaled_to_unit(R_shift_scaled))
1135 : :
1136 : 7278 : end subroutine supercell_get_inbox_wrap
1137 : : !!***
1138 : :
1139 : : !----------------------------------------------------------------------
1140 : :
1141 : : !!****f* m_tdep_supercell/supercell_make_box_centered
1142 : : !! NAME
1143 : : !! supercell_make_box_centered
1144 : : !!
1145 : : !! FUNCTION
1146 : : !! Set the R_sh shift of every atom so that its supercell reduced
1147 : : !! coordinates fold into [-0.5,0.5).
1148 : : !!
1149 : : !! SIDE EFFECTS
1150 : : !! SC=supercell object, R_sh is updated on output
1151 : : !!
1152 : : !! SOURCE
1153 : :
1154 : 46 : subroutine supercell_make_box_centered(SC)
1155 : :
1156 : : class(tdep_Supercell_type),intent(inout) :: SC
1157 : : integer :: iat
1158 : : integer :: R_at(3), R_shift(3)
1159 : : real(dp) :: R_shift_scaled(3)
1160 : :
1161 [ + + ]: 7324 : do iat=1,SC%natom
1162 : 7278 : call SC%get_inbox_wrap(iat, R_shift, R_shift_scaled)
1163 [ + + ]: 29112 : R_at = SC%get_R_at(iat)
1164 [ + + ]: 29158 : call SC%set_R_at(iat, R_at-R_shift)
1165 : : end do
1166 : :
1167 : 46 : end subroutine supercell_make_box_centered
1168 : : !!***
1169 : :
1170 : : !----------------------------------------------------------------------
1171 : :
1172 : : !!****f* m_tdep_supercell/supercell_get_xred_atom
1173 : : !! NAME
1174 : : !! supercell_get_xred_atom
1175 : : !!
1176 : : !! FUNCTION
1177 : : !! Get the position of an atom, in unitcell reduced coordinates.
1178 : : !!
1179 : : !! INPUTS
1180 : : !! iat_super=index of the atom in the supercell
1181 : : !!
1182 : : !! OUTPUT
1183 : : !! xred(3)=position, in unitcell reduced coordinates
1184 : : !!
1185 : : !! SOURCE
1186 : :
1187 [ - + ]: 116486720 : function supercell_get_xred_atom(SC,iat_super) result(xred)
1188 : : class(tdep_Supercell_type),intent(in) :: SC
1189 : : integer, intent(in) :: iat_super
1190 : : integer :: icell, iat_unit
1191 : : real(dp) :: xred(3)
1192 : :
1193 : 116486720 : call SC%get_iat_unitcell(iat_super, icell, iat_unit)
1194 [ + + ]: 465946880 : xred(:) = SC%R_red(:,icell) + SC%R_sh(:,iat_super) + SC%xred_unitcell(:,iat_unit)
1195 : :
1196 : 116486720 : end function supercell_get_xred_atom
1197 : : !!***
1198 : :
1199 : : !----------------------------------------------------------------------
1200 : :
1201 : : !!****f* m_tdep_supercell/supercell_get_xred_scaled_atom
1202 : : !! NAME
1203 : : !! supercell_get_xred_scaled_atom
1204 : : !!
1205 : : !! FUNCTION
1206 : : !! Get the position of an atom, in supercell reduced coordinates.
1207 : : !! If wrap is given and true, the result is wrapped into the centered
1208 : : !! box [-0.5,0.5).
1209 : : !!
1210 : : !! INPUTS
1211 : : !! iat_super=index of the atom in the supercell
1212 : : !! wrap=optional, if true, wrap the result into [-0.5,0.5). Defaults to
1213 : : !! false (no wrapping) when absent.
1214 : : !!
1215 : : !! OUTPUT
1216 : : !! xred_scaled(3)=position, in supercell reduced coordinates
1217 : : !!
1218 : : !! SOURCE
1219 : :
1220 [ - + ]: 113340398 : function supercell_get_xred_scaled_atom(SC,iat_super,wrap) result(xred_scaled)
1221 : : class(tdep_Supercell_type),intent(in) :: SC
1222 : : integer, intent(in) :: iat_super
1223 : : logical, intent(in), optional :: wrap
1224 : : real(dp) :: xred_scaled(3)
1225 : : real(dp) :: xred(3)
1226 : :
1227 [ + + ]: 453361592 : xred = SC%get_xred(iat_super)
1228 [ + + ]: 453361592 : xred_scaled = SC%unit_to_scaled(xred)
1229 : :
1230 [ - + ]: 113340398 : if (present(wrap)) then
1231 [ # # ]: 0 : if (wrap) then
1232 [ # # ]: 0 : xred_scaled = SC%wrap_inbox(xred_scaled)
1233 : : end if
1234 : : end if
1235 : :
1236 : 113340398 : end function supercell_get_xred_scaled_atom
1237 : : !!***
1238 : :
1239 : : !----------------------------------------------------------------------
1240 : :
1241 : : !!****f* m_tdep_supercell/supercell_get_xcart_atom
1242 : : !! NAME
1243 : : !! supercell_get_xcart_atom
1244 : : !!
1245 : : !! FUNCTION
1246 : : !! Get the position of an atom, in cartesian coordinates.
1247 : : !!
1248 : : !! INPUTS
1249 : : !! iat_super=index of the atom in the supercell
1250 : : !!
1251 : : !! OUTPUT
1252 : : !! xcart(3)=position, in cartesian coordinates
1253 : : !!
1254 : : !! SOURCE
1255 : :
1256 [ - + ]: 6036 : function supercell_get_xcart_atom(SC,iat_super) result(xcart)
1257 : : class(tdep_Supercell_type),intent(in) :: SC
1258 : : integer, intent(in) :: iat_super
1259 : : real(dp) :: xcart(3)
1260 : : real(dp) :: xred(3)
1261 : :
1262 [ + + ]: 24144 : xred = SC%get_xred(iat_super)
1263 [ + + ]: 24144 : xcart = SC%red_to_cart(xred)
1264 : :
1265 : 6036 : end function supercell_get_xcart_atom
1266 : : !!***
1267 : :
1268 : : !----------------------------------------------------------------------
1269 : :
1270 : : !!****f* m_tdep_supercell/supercell_set_R_at
1271 : : !! NAME
1272 : : !! supercell_set_R_at
1273 : : !!
1274 : : !! FUNCTION
1275 : : !! Set the lattice vector R of an atom, by adjusting its R_sh shift.
1276 : : !!
1277 : : !! INPUTS
1278 : : !! iat_super=index of the atom in the supercell
1279 : : !! R_at(3)=lattice vector to assign to the atom
1280 : : !!
1281 : : !! SIDE EFFECTS
1282 : : !! SC=supercell object, R_sh is updated on output
1283 : : !!
1284 : : !! SOURCE
1285 : :
1286 : 7278 : subroutine supercell_set_R_at(SC,iat_super,R_at)
1287 : : class(tdep_Supercell_type),intent(inout) :: SC
1288 : : integer, intent(in) :: iat_super
1289 : : integer, intent(in) :: R_at(3)
1290 : : integer :: icell, iat_unit
1291 : : integer :: R_red(3)
1292 : : integer :: R_sh(3)
1293 : :
1294 : 7278 : call SC%get_iat_unitcell(iat_super, icell, iat_unit)
1295 : :
1296 [ + + ]: 29112 : R_red = SC%R_red(:,icell)
1297 [ + + ]: 29112 : R_sh = R_at - R_red
1298 : :
1299 [ - + ]: 7278 : if (.not. SC%is_mod0(R_sh)) then
1300 : 0 : ABI_ERROR('Invalid R_at assigned.')
1301 : : end if
1302 : :
1303 [ + + ]: 29112 : SC%R_sh(:,iat_super) = R_sh(:)
1304 : :
1305 : 7278 : end subroutine supercell_set_R_at
1306 : : !!***
1307 : :
1308 : : !----------------------------------------------------------------------
1309 : :
1310 : : !!****f* m_tdep_supercell/supercell_find_nearest_atom
1311 : : !! NAME
1312 : : !! supercell_find_nearest_atom
1313 : : !!
1314 : : !! FUNCTION
1315 : : !! Search for an atom in the supercell, and find the matching lattice vector and
1316 : : !! unitcell atom.
1317 : : !!
1318 : : !! INPUTS
1319 : : !! xcart(3)=cartesian coordinates of the atom we are searching
1320 : : !! typat=type of the atom we are searching
1321 : : !!
1322 : : !! OUTPUT
1323 : : !! iat_super=index of the matching atom in the supercell
1324 : : !! R_at(3)=lattice vector of the matching atom
1325 : : !! ucart(3)=displacement vector of xcart with respect to the position
1326 : : !! of the matching atom in the supercell
1327 : : !!
1328 : : !! SOURCE
1329 : :
1330 : 7278 : subroutine supercell_find_nearest_atom(SC,xcart,typat,iat_super,R_at,ucart)
1331 : : class(tdep_Supercell_type),intent(in) :: SC
1332 : : real(dp), intent(in) :: xcart(3)
1333 : : integer, intent(in) :: typat
1334 : : integer, intent(out) :: iat_super
1335 : : integer, intent(out) :: R_at(3)
1336 : : real(dp), intent(out) :: ucart(3)
1337 : :
1338 : : logical :: found
1339 : : integer :: icell
1340 : : integer :: iat_unit
1341 : : integer :: iat
1342 : : integer :: ii,jj,kk
1343 : : integer :: RR(3)
1344 : : integer :: Rcan(3)
1345 : :
1346 : : integer :: Rshift_found(3)
1347 : : integer :: Rshift_try(3)
1348 : : real(dp) :: xred(3),xred_try(3)
1349 : : real(dp) :: xred_at_unitcell(3)
1350 : : real(dp) :: xred_origin_cell(3),xcart_origin_cell(3)
1351 : : real(dp) :: xcart_try(3), ucart_try(3)
1352 : : real(dp) :: unorm_try, unorm
1353 : :
1354 [ + + ]: 29112 : xred = SC%cart_to_red(xcart)
1355 : :
1356 [ + + ]: 29112 : do ii=1,3
1357 : 29112 : RR(ii) = NINT(xred(ii))
1358 : : end do
1359 : :
1360 [ + + ]: 29112 : xred_origin_cell = xred - RR
1361 [ + + ]: 29112 : xcart_origin_cell = SC%red_to_cart(xred_origin_cell)
1362 : :
1363 : : ! Loop over atoms of the unitcell
1364 : 7278 : found = .false.
1365 : 7278 : iat_unit = zero
1366 : 7278 : Rshift_found = zero
1367 : 7278 : ucart = zero
1368 : 7278 : unorm = greatest_real
1369 : :
1370 [ + + ]: 22956 : do iat=1,SC%natom_unitcell
1371 : :
1372 [ + + ]: 15678 : if (SC%typat_unitcell(iat) .ne. typat) cycle
1373 : :
1374 [ + + ]: 54072 : xred_at_unitcell(:) = SC%xred_unitcell(:,iat)
1375 : :
1376 [ + + ]: 61350 : do ii=-1,1
1377 [ + + ]: 177894 : do jj=-1,1
1378 [ + + ]: 527202 : do kk=-1,1
1379 : :
1380 [ + + ]: 1459944 : Rshift_try(:) = (/ii, jj, kk/)
1381 [ + + ]: 1459944 : xred_try = Rshift_try + xred_at_unitcell
1382 [ + + ]: 1459944 : xcart_try = SC%red_to_cart(xred_try)
1383 : :
1384 [ + + ]: 1459944 : ucart_try(:) = xcart_try(:) - xcart_origin_cell(:)
1385 : 364986 : unorm_try = normv(ucart_try)
1386 : :
1387 : : ! Store the best match
1388 [ + + ]: 486648 : if (unorm_try < unorm) then
1389 : 42336 : found = .true.
1390 : 42336 : unorm = unorm_try
1391 : 42336 : ucart = ucart_try
1392 : 42336 : Rshift_found = Rshift_try ! As it turns out, this is zero in test atdep_t01.
1393 : 42336 : iat_unit = iat
1394 : : end if
1395 : :
1396 : : end do
1397 : : end do
1398 : : end do
1399 : :
1400 : : end do
1401 : :
1402 [ - + ]: 7278 : if (.not. found) then
1403 : 0 : ABI_ERROR('Atom not found.')
1404 : : end if
1405 : :
1406 : : ! Shift RR with the matching Rshift to recover the unitcell lattice vector
1407 [ + + ]: 29112 : R_at = RR + Rshift_found
1408 : :
1409 [ + + ]: 29112 : Rcan = SC%modH(R_at)
1410 : 7278 : icell = SC%get_icell(Rcan)
1411 : 7278 : iat_super = SC%get_iat_supercell(icell, iat_unit)
1412 : :
1413 : 7278 : end subroutine supercell_find_nearest_atom
1414 : : !!***
1415 : :
1416 : : !----------------------------------------------------------------------
1417 : :
1418 : : !!****f* m_tdep_supercell/supercell_atoms_distance
1419 : : !! NAME
1420 : : !! supercell_atoms_distance
1421 : : !!
1422 : : !! FUNCTION
1423 : : !! Compute the cartesian vector and distance between two atoms,
1424 : : !! using the minimum image convention.
1425 : : !!
1426 : : !! INPUTS
1427 : : !! iat_super=index of the first atom in the supercell
1428 : : !! jat_super=index of the second atom in the supercell
1429 : : !!
1430 : : !! OUTPUT
1431 : : !! xij(3)=cartesian vector from atom iat_super to atom jat_super
1432 : : !! dist=distance between the two atoms
1433 : : !!
1434 : : !! SOURCE
1435 : :
1436 : 1551364 : subroutine supercell_atoms_distance(SC, iat_super, jat_super, xij, dist)
1437 : : class(tdep_Supercell_type),intent(in) :: SC
1438 : : integer, intent(in) :: iat_super, jat_super
1439 : : real(dp), intent(out) :: xij(3)
1440 : : real(dp), intent(out) :: dist
1441 : :
1442 : : real(dp) :: xred_i(3), xred_j(3)
1443 : : real(dp) :: xred_ij_scaled(3)
1444 : :
1445 [ - + + + ]: 7756820 : xred_i = SC%unit_to_scaled(SC%get_xred(iat_super))
1446 [ - + + + ]: 7756820 : xred_j = SC%unit_to_scaled(SC%get_xred(jat_super))
1447 : :
1448 [ + + ]: 6205456 : xred_ij_scaled = xred_j - xred_i
1449 [ + + ]: 6205456 : xred_ij_scaled = SC%wrap_inbox(xred_ij_scaled)
1450 : :
1451 [ + + ]: 6205456 : xij = SC%red_scaled_to_cart(xred_ij_scaled)
1452 : 1551364 : dist = normv(xij)
1453 : :
1454 : 1551364 : end subroutine supercell_atoms_distance
1455 : : !!***
1456 : :
1457 : : !----------------------------------------------------------------------
1458 : :
1459 : : !!****f* m_tdep_supercell/supercell_calc_dij
1460 : : !! NAME
1461 : : !! supercell_calc_dij
1462 : : !!
1463 : : !! FUNCTION
1464 : : !! Compute the cartesian vector and distance between all pairs of atoms
1465 : : !! in the supercell, using the minimum image convention, and store the
1466 : : !! result in SC%dij. This array is not needed by all callers, so it is
1467 : : !! not computed as part of supercell_init: call this routine explicitly
1468 : : !! whenever SC%dij is required.
1469 : : !!
1470 : : !! SIDE EFFECTS
1471 : : !! SC=supercell object, dij is allocated (if needed) and filled on output
1472 : : !!
1473 : : !! SOURCE
1474 : :
1475 : 46 : subroutine supercell_calc_dij(SC)
1476 : :
1477 : : class(tdep_Supercell_type),intent(inout) :: SC
1478 : :
1479 : : integer :: iatom,jatom
1480 : : real(dp) :: xij(3)
1481 : : real(dp) :: dist
1482 : :
1483 [ + - ]: 46 : if (.not. allocated(SC%dij)) then
1484 [ - + + - : 230 : ABI_MALLOC(SC%dij, (SC%natom,SC%natom,4))
- + + - +
- + - + -
- + - + -
+ ]
1485 : : end if
1486 : :
1487 [ + + ]: 7324 : do iatom=1,SC%natom
1488 [ + + ]: 1558688 : do jatom=1,SC%natom
1489 : 1551364 : call SC%atoms_distance(iatom, jatom, xij, dist)
1490 : 1551364 : SC%dij(iatom,jatom,1) = dist
1491 [ + + ]: 6212734 : SC%dij(iatom,jatom,2:4) = xij(1:3)
1492 : : end do
1493 : : end do
1494 : :
1495 : 46 : end subroutine supercell_calc_dij
1496 : : !!***
1497 : :
1498 : : !----------------------------------------------------------------------
1499 : :
1500 : : ! Find the list of R vectors belonging to the shell of lattice vector R.
1501 : :
1502 : : ! subroutine supercell_find_R_shell(SC, RR, N_shell, R_shell, dist)
1503 : : ! class(tdep_Supercell_type),intent(in) :: SC
1504 : : ! integer, intent(in) :: RR(3)
1505 : : ! real(dp), intent(out) :: dist
1506 : : ! integer, intent(out) :: N_shell
1507 : : ! integer, allocatable, intent(out) :: R_shell(:,:) ! R_shell(N_shell, 3)
1508 : : !
1509 : : ! end subroutine supercell_find_R_shell
1510 : :
1511 : : ! Find the list of R vectors belonging to the shell of lattice vector R.
1512 : : !subroutine supercell_find_atom_shell(SC, iat, N_shell, R_shell, dist)
1513 : : ! class(tdep_Supercell_type),intent(in) :: SC
1514 : : ! integer, intent(in) :: iat
1515 : : ! real(dp), intent(out) :: dist
1516 : : ! integer, intent(out) :: N_shell
1517 : : ! integer, allocatable, intent(out) :: R_shell(:,:)
1518 : : !
1519 : : !end subroutine supercell_find_atom_shell
1520 : :
1521 : : !----------------------------------------------------------------------
1522 : :
1523 [ # # # # : 0 : end module m_tdep_supercell
# # # # #
# # # # #
# # # # #
# # # #
# ]
|
