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