Line data Source code
1 : !!****m* ABINIT/m_defs_ptgroups
2 : !! NAME
3 : !! m_defs_ptgroups
4 : !!
5 : !! FUNCTION
6 : !! This module contains the definition of the point_group_t datatype used to
7 : !! represent one of the 32 different point groups. It also provides the definition
8 : !! of the irrept_t structure that is used to store one of the irreducible
9 : !! representations of the group
10 : !!
11 : !! NOTES
12 : !! Methods "bound" to the point_group_t datatype are defined in the
13 : !! separate module m_ptgroups in order to avoid cyclic dependencies.
14 : !! The automatically generated ptg_* routines indeed use irrept_t and
15 : !! cannot be #included here. The size of the final module
16 : !! is indeed huge (>4000 lines) and several compilers are not able to
17 : !! compile the module in reasonable time when -O2 is used.
18 : !!
19 : !! COPYRIGHT
20 : !! Copyright (C) 2010-2026 ABINIT group (MG)
21 : !! This file is distributed under the terms of the
22 : !! GNU General Public License, see ~abinit/COPYING
23 : !! or http://www.gnu.org/copyleft/gpl.txt .
24 : !!
25 :
26 : #if defined HAVE_CONFIG_H
27 : #include "config.h"
28 : #endif
29 :
30 : #include "abi_common.h"
31 :
32 : module m_defs_ptgroups
33 :
34 : use defs_basis
35 : use m_abicore
36 : use m_errors
37 :
38 : use m_numeric_tools, only : get_trace
39 :
40 : implicit none
41 :
42 : private
43 :
44 : character(len=5),public :: ptgroup_names(32) = (/ &
45 : "1 ", &
46 : "-1 ", &
47 : "2 ", &
48 : "m ", &
49 : "2/m ", &
50 : "222 ", &
51 : "mm2 ", &
52 : "mmm ", &
53 : "4 ", &
54 : "-4 ", &
55 : "4/m ", &
56 : "422 ", &
57 : "4mm ", &
58 : "-42m ", &
59 : "4/mmm", &
60 : "3 ", &
61 : "-3 ", &
62 : "32 ", &
63 : "3m ", &
64 : "-3m ", &
65 : "6 ", &
66 : "-6 ", &
67 : "6/m ", &
68 : "622 ", &
69 : "6mm ", &
70 : "-62m ", &
71 : "6/mmm", &
72 : "23 ", &
73 : "m-3 ", &
74 : "432 ", &
75 : "-43m ", &
76 : "m-3m " /)
77 :
78 : integer,parameter,public :: IRREPNAME_LEN=10
79 : !!***
80 :
81 : !!****t* m_defs_ptgroups/irrep_t
82 : !! NAME
83 : !! irrep_t
84 : !!
85 : !! FUNCTION
86 : !! Datatype representing an (irreducible) representation of the group.
87 : !!
88 : !! SOURCE
89 :
90 : type,public :: irrep_t
91 :
92 : integer :: dim
93 : ! The dimension of the irreducible representation.
94 :
95 : integer :: nsym
96 : ! The number of symmetries in the group.
97 :
98 : character(len=IRREPNAME_LEN) :: name="???"
99 : ! The name of the irreducible representation.
100 :
101 : complex(dp),allocatable :: mat(:,:,:)
102 : ! mat(dim,dim,nsym)
103 : ! The irreducible representations of the group.
104 :
105 : complex(dp),allocatable :: trace(:)
106 : ! trace(nsym)
107 : ! The trace of each matrix.
108 :
109 : contains
110 : procedure :: init => init_irrep
111 : procedure :: free => irrep_free_0d
112 :
113 : end type irrep_t
114 : !!***
115 :
116 : public :: copy_irrep
117 :
118 : interface irrep_free
119 : module procedure irrep_free_0d
120 : module procedure irrep_free_1d
121 : end interface irrep_free
122 : public :: irrep_free
123 :
124 : !----------------------------------------------------------------------
125 :
126 : !!****t* m_defs_ptgroups/point_group_t
127 : !! NAME
128 : !! point_group_t
129 : !!
130 : !! FUNCTION
131 : !! Datatype used to collect data concerning one of the 32 different point groups.
132 : !!
133 : !! SOURCE
134 :
135 : type,public :: point_group_t
136 :
137 : !integer :: numspg
138 : ! Number of the space group.
139 :
140 : integer :: nsym
141 : ! Number of symmetries in the point group.
142 :
143 : integer :: nclass
144 : ! Number of classes (equals the number of irreducible representations).
145 :
146 : character(len=5) :: gname
147 : ! Point group name.
148 :
149 : !character(len=10) :: setting
150 : ! Information about the space group setting (Table, Standard)
151 :
152 : integer,allocatable :: class_ids(:,:)
153 : ! class_ids(2,nclass)
154 : ! (1,icl) = index of the first symmetry of class icl
155 : ! (2,icl) = index of the last symmetry of class icl
156 : ! Note that symmetries in the sym array are packed in classes.
157 :
158 : integer,allocatable :: sym(:,:,:)
159 : ! The symmetry operations packed in classes.
160 : ! NB: operations are referred to the standard coordinate system.
161 : ! Page 815-816 of International Tables for crystallography Vol.A.
162 :
163 : !$integer,allocatable :: symafm(:)
164 : ! symafm(nsym)
165 : ! AFM part of the symmetry operation
166 :
167 : !$real(dp),allocatable :: tnons(:,:)
168 : ! tnons(3,nsym)
169 : ! fractional translations.
170 :
171 : character(len=5),allocatable :: class_names(:)
172 : ! class_names(nclass)
173 : ! The name of each class.
174 :
175 : type(irrep_t),allocatable :: Irreps(:)
176 : ! Irreps(nclass)
177 : ! Array storing the irreducible representations of the point group.
178 : ! Initialized from the tables downloaded from the Bilbao server.
179 :
180 : contains
181 :
182 : procedure :: free => point_group_free
183 : procedure :: print => point_group_print
184 : procedure :: locate_sym => locate_sym
185 :
186 : end type point_group_t
187 : !!***
188 :
189 : !----------------------------------------------------------------------
190 :
191 : !!****t* m_defs_ptgroups/group_k_t
192 : !! NAME
193 : !! group_k_t
194 : !!
195 : !! FUNCTION
196 : !! Datatype used to collect data on the little group.
197 : !!
198 : !! SOURCE
199 :
200 : type,public :: group_k_t
201 :
202 : integer :: spgroup
203 : ! ITA space group number.
204 :
205 : integer :: nsym
206 : ! Number of symmetries in the little group.
207 :
208 : integer :: nclass
209 : ! Number of classes (equals the number of irreducible representations).
210 :
211 : integer,allocatable :: class_ids(:,:)
212 : ! class_ids(2,nclass)
213 : ! (1,icl) = index of the first symmetry of class icl
214 : ! (2,icl) = index of the last symmetry of class icl
215 : ! Note that symmetries in sym are packed in classes.
216 :
217 : integer,allocatable :: sym(:,:,:)
218 : ! sym(3,3,nsym)
219 : ! The symmetry operations of the little group packed in classes.
220 : ! NB: operations are referred to the standard coordinate system.
221 : ! Page 815-816 of Internationat Tables for crystallography Vol.A.
222 :
223 : real(dp) :: point(3)
224 : ! The point referred to the standard coordinate system.
225 :
226 : real(dp),allocatable :: tnons(:,:)
227 : ! tnons(3,nsym)
228 : ! Fractional translations of the little group.
229 : ! NB: operations are referred to the standard coordinate system.
230 : ! Page 815-816 of Internationat Tables for crystallography Vol.A.
231 :
232 : character(len=5),allocatable :: class_names(:)
233 : ! class_names(nclass)
234 : ! The name of each class.
235 :
236 : type(irrep_t),allocatable :: Irreps(:)
237 : ! Irreps(nclass)
238 : ! The set of irreducible representations of the point group.
239 :
240 : contains
241 : procedure :: free => groupk_free
242 : end type group_k_t
243 : !!***
244 :
245 : contains
246 :
247 : !----------------------------------------------------------------------
248 :
249 : !!****f* m_ptgroups/point_group_free
250 : !! NAME
251 : !! point_group_free
252 : !!
253 : !! FUNCTION
254 : !! Deallocate all memory allocated in the point_group_t datatype.
255 : !!
256 : !! SOURCE
257 :
258 0 : subroutine point_group_free(Ptg)
259 :
260 : !Arguments ------------------------------------
261 : class(point_group_t),intent(inout) :: Ptg
262 : ! *********************************************************************
263 :
264 0 : ABI_SFREE(Ptg%class_ids)
265 0 : ABI_SFREE(Ptg%sym)
266 0 : ABI_SFREE(Ptg%class_names)
267 :
268 0 : if (allocated(Ptg%Irreps)) then
269 0 : call irrep_free(Ptg%Irreps)
270 0 : ABI_FREE(Ptg%Irreps)
271 : end if
272 :
273 0 : end subroutine point_group_free
274 : !!***
275 :
276 : !----------------------------------------------------------------------
277 :
278 : !!****f* m_ptgroups/point_group_print
279 : !! NAME
280 : !! point_group_print
281 : !!
282 : !! FUNCTION
283 : !!
284 : !! INPUTS
285 : !!
286 : !! OUTPUT
287 : !!
288 : !! SOURCE
289 :
290 0 : subroutine point_group_print(Ptg, header, unit, mode_paral, prtvol)
291 :
292 : !Arguments ------------------------------------
293 : !scalars
294 : class(point_group_t),target,intent(in) :: Ptg
295 : integer,optional,intent(in) :: unit,prtvol
296 : character(len=4),optional,intent(in) :: mode_paral
297 : character(len=*),optional,intent(in) :: header
298 :
299 : !Local variables-------------------------------
300 : integer :: my_unt,my_prtvol,irp,icls,sidx
301 : complex(dp) :: trace
302 : character(len=4) :: my_mode
303 : character(len=500) :: msg
304 : type(irrep_t),pointer :: Row
305 : ! *********************************************************************
306 :
307 0 : my_unt =std_out; if (PRESENT(unit )) my_unt =unit
308 0 : my_prtvol=0 ; if (PRESENT(prtvol )) my_prtvol=prtvol
309 0 : my_mode ='COLL' ; if (PRESENT(mode_paral)) my_mode =mode_paral
310 :
311 0 : msg=' ==== Point Group Table ==== '
312 0 : if (PRESENT(header)) msg=' ==== '//TRIM(ADJUSTL(header))//' ==== '
313 0 : call wrtout(my_unt,msg,my_mode)
314 :
315 0 : write(std_out,*)REPEAT("=",80)
316 0 : write(std_out,*)" Point group : ",TRIM(Ptg%gname)," Number of symmetries ",Ptg%nsym," Number of classes ",Ptg%nclass
317 :
318 0 : write(std_out,"(a6)",advance="no")"Class "
319 0 : do icls=1,Ptg%nclass
320 0 : write(std_out,"('|',a10)",advance="no")Ptg%class_names(icls)
321 : end do
322 0 : write(std_out,"('|')",advance="no")
323 0 : write(std_out,*)" "
324 :
325 0 : write(std_out,"(a6)",advance="no")"Mult "
326 0 : do icls=1,Ptg%nclass
327 0 : write(std_out,"('|',i10)",advance="no")Ptg%class_ids(2,icls)-Ptg%class_ids(1,icls) + 1
328 : end do
329 0 : write(std_out,"('|')",advance="no")
330 0 : write(std_out,*)" "
331 :
332 0 : do irp=1,SIZE(Ptg%Irreps)
333 0 : Row => Ptg%Irreps(irp)
334 0 : write(std_out,'(a6)',advance="no")TRIM(Row%name)
335 :
336 0 : do icls=1,Ptg%nclass
337 0 : sidx = Ptg%class_ids(1,icls)
338 0 : trace = Row%trace(sidx)
339 0 : if (ABS(AIMAG(trace)) > tol6) then
340 0 : write(std_out,"('|',(2f5.2))",advance="no")trace
341 : else
342 0 : write(std_out,"('|',(f10.2))",advance="no")REAL(trace)
343 : end if
344 : end do
345 :
346 0 : write(std_out,"('|')",advance="no")
347 0 : write(std_out,*)" "
348 : end do
349 :
350 0 : write(std_out,*)REPEAT("=",80)
351 :
352 0 : end subroutine point_group_print
353 : !!***
354 :
355 : !----------------------------------------------------------------------
356 :
357 : !!****f* m_defs_ptgroups/locate_sym
358 : !! NAME
359 : !! locate_sym
360 : !!
361 : !! FUNCTION
362 : !! Given a symmetry operation asym, this routine returns its index in the Ptg%sym
363 : !! array and the index of the class it belongs to.
364 : !!
365 : !! INPUTS
366 : !!
367 : !! OUTPUT
368 : !!
369 : !! SOURCE
370 :
371 0 : subroutine locate_sym(Ptg, asym, sym_idx, cls_idx, ierr)
372 :
373 : !Arguments ------------------------------------
374 : !scalars
375 : class(point_group_t),intent(in) :: Ptg
376 : integer,intent(out) :: sym_idx,cls_idx
377 : integer,optional,intent(out) :: ierr
378 : !arrays
379 : integer,intent(in) :: asym(3,3)
380 :
381 : !Local variables-------------------------------
382 : integer :: isym,icls
383 : character(len=500) :: msg
384 : ! *********************************************************************
385 :
386 0 : sym_idx = 0
387 0 : do isym=1,Ptg%nsym
388 0 : if (ALL(asym == Ptg%sym(:,:,isym) )) then
389 0 : sym_idx = isym
390 0 : EXIT
391 : end if
392 : end do
393 :
394 0 : cls_idx = 0
395 0 : do icls=1,Ptg%nclass
396 0 : if (sym_idx >= Ptg%class_ids(1,icls) .and. sym_idx <= Ptg%class_ids(2,icls) ) then
397 0 : cls_idx = icls
398 0 : EXIT
399 : end if
400 : end do
401 :
402 0 : if (PRESENT(ierr)) ierr=0
403 0 : if (sym_idx==0 .or. cls_idx==0) then
404 : write(msg,'(a,9(i0,1x),3a,i1,a,i1)')&
405 0 : " Symmetry: ",asym," not found in point group table ",ch10,&
406 0 : " sym_idx= ",sym_idx, " and cls_idx= ",cls_idx
407 0 : if (PRESENT(ierr)) then
408 0 : ierr=1
409 0 : ABI_WARNING(msg)
410 : else
411 0 : ABI_ERROR(msg)
412 : end if
413 : end if
414 :
415 0 : end subroutine locate_sym
416 : !!***
417 :
418 : !----------------------------------------------------------------------
419 :
420 : !!****f* m_defs_ptgroups/irrep_free_0d
421 : !! NAME
422 : !! irrep_free_0d
423 : !!
424 : !! FUNCTION
425 : !! Deallocate all memory allocated in the irrep_t datatype.
426 : !!
427 : !! SOURCE
428 :
429 0 : subroutine irrep_free_0d(Irrep)
430 :
431 : !Arguments ------------------------------------
432 : class(irrep_t),intent(inout) :: Irrep
433 : ! *********************************************************************
434 :
435 0 : ABI_SFREE(Irrep%trace)
436 0 : ABI_SFREE(Irrep%mat)
437 :
438 0 : end subroutine irrep_free_0d
439 : !!***
440 :
441 : !----------------------------------------------------------------------
442 :
443 : !!****f* m_defs_ptgroups/irrep_free_1d
444 : !! NAME
445 : !! irrep_free_1d
446 : !!
447 : !! FUNCTION
448 : !! Deallocate all memory allocated in the irrep_t datatype.
449 : !!
450 : !! SOURCE
451 :
452 0 : subroutine irrep_free_1d(Irrep)
453 :
454 : !Arguments ------------------------------------
455 : class(irrep_t),intent(inout) :: Irrep(:)
456 :
457 : !Local variables-------------------------------
458 : integer :: irp
459 : ! *********************************************************************
460 :
461 0 : do irp=1,SIZE(Irrep)
462 0 : call irrep_free_0d(Irrep(irp))
463 : end do
464 :
465 0 : end subroutine irrep_free_1d
466 : !!***
467 :
468 : !----------------------------------------------------------------------
469 :
470 : !!****f* m_defs_ptgroups/copy_irrep
471 : !! NAME
472 : !! copy_irrep
473 : !!
474 : !! FUNCTION
475 : !! Perform a copy of a set of irrep_t datatypes. Optionally one can multiply
476 : !! by a phase factor.
477 : !!
478 : !! SOURCE
479 :
480 0 : subroutine copy_irrep(In_irreps, Out_irreps, phase_fact)
481 :
482 : !Arguments ------------------------------------
483 : class(irrep_t),intent(in) :: In_irreps(:)
484 : class(irrep_t),intent(inout) :: Out_irreps(:)
485 : complex(dp),optional,intent(in) :: phase_fact(:)
486 :
487 : !Local variables-------------------------------
488 : !scalars
489 : integer :: irp,dim1,dim2,in_nsym,in_dim,isym
490 : !arrays
491 0 : complex(dp) :: my_phase_fact(In_irreps(1)%nsym)
492 : ! *********************************************************************
493 :
494 : !@irrep_t
495 0 : dim1 = SIZE( In_irreps)
496 0 : dim2 = SIZE(Out_irreps)
497 0 : if (dim1 /= dim2) then
498 0 : ABI_ERROR("irreps to be copied have different dimension")
499 : end if
500 :
501 0 : my_phase_fact=cone
502 0 : if (PRESENT(phase_fact)) then
503 0 : my_phase_fact=phase_fact
504 0 : if (SIZE(phase_fact) /= In_irreps(1)%nsym) then
505 0 : ABI_ERROR("irreps to be copied have different dimension")
506 : end if
507 : end if
508 :
509 0 : do irp=1,dim1
510 0 : in_dim = In_irreps(irp)%dim
511 0 : in_nsym = In_irreps(irp)%nsym
512 0 : call init_irrep(Out_irreps(irp),in_nsym,in_dim)
513 0 : Out_irreps(irp)%name = In_irreps(irp)%name
514 0 : do isym=1,in_nsym
515 0 : Out_irreps(irp)%mat(:,:,isym) = In_irreps(irp)%mat(:,:,isym) * my_phase_fact(isym)
516 0 : Out_irreps(irp)%trace(isym) = get_trace(Out_irreps(irp)%mat(:,:,isym))
517 : end do
518 : end do
519 :
520 0 : end subroutine copy_irrep
521 : !!***
522 :
523 : !----------------------------------------------------------------------
524 :
525 : !!****f* m_defs_ptgroups/init_irrep
526 : !! NAME
527 : !! alloc_irrep
528 : !!
529 : !! FUNCTION
530 : !! Initialize an instance of the irrep_t datatype.
531 : !!
532 : !! INPUTS
533 : !! nsym=The number of symmetries.
534 : !! irr_dim=The dimension of the irrep.
535 : !! [irr_name]=The name of theirrep. "???" is used if not given
536 : !!
537 : !! OUTPUT
538 : !! Irrep<irrep_t>=
539 : !!
540 : !! SOURCE
541 :
542 0 : subroutine init_irrep(Irrep, nsym, irr_dim, irr_name)
543 :
544 : !Arguments ------------------------------------
545 : !scalars
546 : class(irrep_t),intent(inout) :: Irrep
547 : integer,intent(in) :: nsym
548 : !arrays
549 : integer,intent(in) :: irr_dim
550 : character(len=*),optional,intent(in) :: irr_name
551 :
552 : !Local variables-------------------------------
553 : !character(len=500) :: msg
554 : ! *********************************************************************
555 :
556 : !@irrep_t
557 0 : Irrep%dim = irr_dim
558 0 : Irrep%nsym = nsym
559 0 : Irrep%name = "???"
560 0 : if (present(irr_name)) Irrep%name = irr_name
561 :
562 0 : ABI_CALLOC(Irrep%mat,(irr_dim,irr_dim,nsym))
563 0 : ABI_CALLOC(Irrep%trace,(nsym))
564 :
565 0 : end subroutine init_irrep
566 : !!***
567 :
568 : !----------------------------------------------------------------------
569 :
570 : !!****f* m_defs_ptgroups/groupk_free
571 : !! NAME
572 : !! groupk_free
573 : !!
574 : !! FUNCTION
575 : !! Deallocate dynamic memory.
576 : !!
577 : !! SOURCE
578 :
579 0 : subroutine groupk_free(Gk)
580 :
581 : !Arguments ------------------------------------
582 : class(group_k_t),intent(inout) :: Gk
583 : ! *************************************************************************
584 :
585 : ! integer
586 0 : ABI_SFREE(Gk%class_ids)
587 0 : ABI_SFREE(Gk%sym)
588 :
589 : !real
590 0 : ABI_SFREE(Gk%tnons)
591 :
592 : !character
593 0 : ABI_SFREE(Gk%class_names)
594 :
595 : !type
596 0 : if (allocated(Gk%Irreps)) then
597 0 : call irrep_free(Gk%Irreps)
598 0 : ABI_FREE(Gk%Irreps)
599 : end if
600 :
601 0 : end subroutine groupk_free
602 : !!***
603 :
604 0 : end module m_defs_ptgroups
605 : !!***
|
