TABLE OF CONTENTS

ABINIT/m_ptgroups [ Modules ]

[ Top ] [ Modules ]

NAME

 m_ptgroups

FUNCTION

  This module contains the irreducible representations and the
  character tables of the 32 point groups.

COPYRIGHT

 Copyright (C) 2010-2024 ABINIT group (MG)
 This file is distributed under the terms of the
 GNU General Public License, see ~abinit/COPYING
 or http://www.gnu.org/copyleft/gpl.txt .

m_ptgroups/copy_irrep [ Functions ]

[ Top ] [ m_ptgroups ] [ Functions ]

NAME

  copy_irrep

FUNCTION

  Perform a copy of a set of irrep_t datatypes. Optionally one can multiply
  by a phase factor.

SOURCE

892 subroutine copy_irrep(In_irreps,Out_irreps,phase_fact)
893 
894  implicit none
895 
896 !Arguments ------------------------------------
897  type(irrep_t),intent(in) :: In_irreps(:)
898  type(irrep_t),intent(inout) :: Out_irreps(:)
899  complex(dpc),optional,intent(in) :: phase_fact(:)
900 
901 !Local variables-------------------------------
902 !scalars
903  integer :: irp,dim1,dim2,in_nsym,in_dim,isym
904  character(len=500) :: msg
905 !arrays
906  complex(dpc) :: my_phase_fact(In_irreps(1)%nsym)
907 ! *********************************************************************
908 
909  !@irrep_t
910  dim1 = SIZE( In_irreps)
911  dim2 = SIZE(Out_irreps)
912  if (dim1/=dim2) then
913    msg = " irreps to be copied have different dimension"
914    ABI_ERROR(msg)
915  end if
916 
917  my_phase_fact=cone
918  if (PRESENT(phase_fact)) then
919    my_phase_fact=phase_fact
920    if (SIZE(phase_fact) /= In_irreps(1)%nsym) then
921      msg = " irreps to be copied have different dimension"
922      ABI_ERROR(msg)
923    end if
924  end if
925 
926  do irp=1,dim1
927    in_dim  = In_irreps(irp)%dim
928    in_nsym = In_irreps(irp)%nsym
929    call init_irrep(Out_irreps(irp),in_nsym,in_dim)
930    Out_irreps(irp)%name = In_irreps(irp)%name
931    do isym=1,in_nsym
932      Out_irreps(irp)%mat(:,:,isym) = In_irreps(irp)%mat(:,:,isym) * my_phase_fact(isym)
933      Out_irreps(irp)%trace(isym) = get_trace(Out_irreps(irp)%mat(:,:,isym))
934    end do
935  end do
936 
937 end subroutine copy_irrep

m_ptgroups/get_classes [ Functions ]

[ Top ] [ m_ptgroups ] [ Functions ]

NAME

 get_classes

FUNCTION

  Given a set of nsym 3x3 operations in reciprocal or real space,
  which are supposed to form a group, this routine divides the group into classes.

INPUTS

 nsym=number of symmetry operation.
 sym(3,3,nsym)=The symmetry operations.

OUTPUT

 nclass=The number of classes
 nelements(1:nclass)=For each class, the number of elements
 elements_idx(ii,1:nclass)=For each class, this table gives the index
   of its elements (ii=1,..,nelements(iclass))

NOTES

  * A class is defined as the set of distinct elements obtained by
    considering for each element, S, of the group all its conjugate
    elements X^-1 S X where X range over all the elements of the group.

  * It does not work in case of non-collinear magnetism.

  * The routine assumes that anti-ferromagnetic symmetries (if any) have been removed by the caller.

SOURCE

245 subroutine get_classes(nsym,sym,nclass,nelements,elements_idx)
246 
247  implicit none
248 
249 !Arguments ------------------------------------
250 !scalars
251  integer,intent(in) :: nsym
252  integer,intent(out) :: nclass
253 !arrays
254  integer,intent(in) :: sym(3,3,nsym)
255  integer,intent(out) :: nelements(nsym),elements_idx(nsym,nsym)
256 
257 !Local variables-------------------------------
258 !scalars
259  integer :: isym,jsym,ksym,identity_idx,ierr
260  character(len=500) :: msg
261 !arrays
262  integer :: cjg(3,3),ss(3,3),xx(3,3),xxm1(3,3),test(3,3)
263  integer :: identity(3,3)
264  integer :: dummy_symafm(nsym)
265  logical :: found(nsym),found_identity
266 
267 !************************************************************************
268 
269  ! === Check if identity is present in the first position ===
270  identity=RESHAPE((/1,0,0,0,1,0,0,0,1/),(/3,3/)); found_identity=.FALSE.
271 
272  do isym=1,nsym
273    if (ALL(sym(:,:,isym)==identity)) then
274      found_identity=.TRUE.; identity_idx=isym; EXIT
275    end if
276  end do
277  if (.not.found_identity.or.identity_idx/=1) then
278   write(msg,'(3a)')&
279 &  'Either identity is not present or it is not the first operation ',ch10,&
280 &  'check set of symmetry operations '
281   ABI_ERROR(msg)
282  end if
283   
284  dummy_symafm=1
285  call sg_multable(nsym,dummy_symafm,sym,ierr)
286  ABI_CHECK(ierr==0,"Error in group closure")
287 
288  nclass=0; nelements(:)=0; elements_idx(:,:)=0; found(:)=.FALSE.
289  do isym=1,nsym
290    if (.not.found(isym)) then
291      nclass=nclass+1
292      ss(:,:)=sym(:,:,isym)
293 
294      do jsym=1,nsym ! Form conjugate.
295        xx(:,:)=sym(:,:,jsym)
296        call mati3inv(xx,xxm1) ; xxm1=TRANSPOSE(xxm1)
297        cjg(:,:)=MATMUL(xxm1,MATMUL(ss,xx))
298        do ksym=1,nsym ! Is it already found?
299          test(:,:)=sym(:,:,ksym)
300          if (.not.found(ksym).and.(ALL((test-cjg)==0))) then
301            found(ksym)=.TRUE.
302            nelements(nclass)=nelements(nclass)+1
303            elements_idx(nelements(nclass),nclass)=ksym
304          end if
305        end do
306      end do
307 
308    end if
309  end do
310 
311 end subroutine get_classes

m_ptgroups/get_point_group [ Functions ]

[ Top ] [ m_ptgroups ] [ Functions ]

NAME

  get_point_group

FUNCTION

INPUTS

 ptg_name=point group name as returned by symptgroup.

OUTPUT

 nsym=Number of symmetries in the point group.
 nclass=Number of classes.
 sym(3,3,nsym)=Elements of the point group ordered by classe.
 class_ids(2,nclass)=Initial and final index in sym, for each
 Irreps(nclass)=Datatype gathering data on the different irreducible representations.

SOURCE

114 subroutine get_point_group(ptg_name,nsym,nclass,sym,class_ids,class_names,Irreps)
115 
116  implicit none
117 
118 !Arguments ------------------------------------
119 !scalars
120  integer,intent(out) :: nclass,nsym
121  character(len=*),intent(in) :: ptg_name
122 !arrays
123  integer,allocatable,intent(out) :: sym(:,:,:),class_ids(:,:)
124  character(len=5),allocatable,intent(out) :: class_names(:)
125  type(irrep_t),allocatable,intent(out) :: Irreps(:)
126 
127 !Local variables-------------------------------
128 !scalars
129  integer :: irp,isym
130  !character(len=500) :: msg
131 
132 ! *************************************************************************
133 
134  SELECT CASE (TRIM(ADJUSTL(ptg_name)))
135  CASE ('1')
136    call ptg_C1  (nsym,nclass,sym,class_ids,class_names,Irreps)
137  CASE ('-1')
138    call ptg_Ci  (nsym,nclass,sym,class_ids,class_names,Irreps)
139  CASE ('2')
140    call ptg_C2  (nsym,nclass,sym,class_ids,class_names,Irreps)
141  CASE ('m',"-2") ! Abinit uses "-2"
142    call ptg_Cs  (nsym,nclass,sym,class_ids,class_names,Irreps)
143  CASE ('2/m')
144    call ptg_C2h (nsym,nclass,sym,class_ids,class_names,Irreps)
145  CASE ('222')
146    call ptg_D2  (nsym,nclass,sym,class_ids,class_names,Irreps)
147  CASE ('mm2')
148    call ptg_C2v (nsym,nclass,sym,class_ids,class_names,Irreps)
149  CASE ('mmm')
150    call ptg_D2h (nsym,nclass,sym,class_ids,class_names,Irreps)
151  CASE ('4')
152    call ptg_C4  (nsym,nclass,sym,class_ids,class_names,Irreps)
153  CASE ('-4')
154    call ptg_S4  (nsym,nclass,sym,class_ids,class_names,Irreps)
155  CASE ('4/m')
156    call ptg_C4h (nsym,nclass,sym,class_ids,class_names,Irreps)
157  CASE ('422')
158    call ptg_D4  (nsym,nclass,sym,class_ids,class_names,Irreps)
159  CASE ('4mm')
160    call ptg_C4v (nsym,nclass,sym,class_ids,class_names,Irreps)
161  CASE ('-42m')
162    call ptg_D2d (nsym,nclass,sym,class_ids,class_names,Irreps)
163  CASE ('4/mmm')
164    call ptg_D4h (nsym,nclass,sym,class_ids,class_names,Irreps)
165  CASE ('3')
166    call ptg_C3  (nsym,nclass,sym,class_ids,class_names,Irreps)
167  CASE ('-3')
168    call ptg_C3i (nsym,nclass,sym,class_ids,class_names,Irreps)
169  CASE ('32')
170    call ptg_D3  (nsym,nclass,sym,class_ids,class_names,Irreps)
171  CASE ('3m')
172    call ptg_C3v (nsym,nclass,sym,class_ids,class_names,Irreps)
173  CASE ('-3m')
174    call ptg_D3d (nsym,nclass,sym,class_ids,class_names,Irreps)
175  CASE ('6')
176    call ptg_C6  (nsym,nclass,sym,class_ids,class_names,Irreps)
177  CASE ('-6')
178    call ptg_C3h (nsym,nclass,sym,class_ids,class_names,Irreps)
179  CASE ('6/m')
180    call ptg_C6h (nsym,nclass,sym,class_ids,class_names,Irreps)
181  CASE ('622')
182    call ptg_D6  (nsym,nclass,sym,class_ids,class_names,Irreps)
183  CASE ('6mm')
184    call ptg_C6v (nsym,nclass,sym,class_ids,class_names,Irreps)
185  CASE ('-62m')
186    call ptg_D3h (nsym,nclass,sym,class_ids,class_names,Irreps)
187  CASE ('6/mmm')
188    call ptg_D6h (nsym,nclass,sym,class_ids,class_names,Irreps)
189  CASE ('23')
190    call ptg_T   (nsym,nclass,sym,class_ids,class_names,Irreps)
191  CASE ('m-3')
192    call ptg_Th  (nsym,nclass,sym,class_ids,class_names,Irreps)
193  CASE ('432')
194    call ptg_O   (nsym,nclass,sym,class_ids,class_names,Irreps)
195  CASE ('-43m')
196    call ptg_Td  (nsym,nclass,sym,class_ids,class_names,Irreps)
197  CASE ('m-3m')
198    call ptg_Oh  (nsym,nclass,sym,class_ids,class_names,Irreps)
199  CASE DEFAULT
200    ABI_BUG(sjoin("Unknown value for ptg_name:", ptg_name))
201  END SELECT
202 
203  ! Calculate the trace of each irreducible representation in order to have the character at hand.
204  do irp=1,SIZE(Irreps)
205    ABI_MALLOC(Irreps(irp)%trace, (nsym))
206    do isym=1,nsym
207      Irreps(irp)%trace(isym) = get_trace(Irreps(irp)%mat(:,:,isym))
208    end do
209  end do
210 
211 end subroutine get_point_group

m_ptgroups/groupk_free [ Functions ]

[ Top ] [ m_ptgroups ] [ Functions ]

NAME

  groupk_free

FUNCTION

  Deallocate all memory allocate in the group_k_t.

SOURCE

1061 subroutine groupk_free(Gk)
1062 
1063  implicit none
1064 
1065 !Arguments ------------------------------------
1066  type(group_k_t),intent(inout) :: Gk
1067 
1068 ! *************************************************************************
1069 
1070 ! integer
1071  ABI_SFREE(Gk%class_ids)
1072  ABI_SFREE(Gk%sym)
1073 
1074 !real
1075  ABI_SFREE(Gk%tnons)
1076 
1077 !character
1078  ABI_SFREE(Gk%class_names)
1079 
1080 !type
1081  if (allocated(Gk%Irreps)) then
1082    call irrep_free(Gk%Irreps)
1083    ABI_FREE(Gk%Irreps)
1084  end if
1085 
1086 end subroutine groupk_free

m_ptgroups/groupk_from_file [ Functions ]

[ Top ] [ m_ptgroups ] [ Functions ]

NAME

  groupk_from_file

FUNCTION

  Initialize the group_k_t datatype from an external database retrieved from
  the Bilbao server via the ptg.py script.

INPUTS

  fname(len=*)=file name

OUTPUT

  ierr=Status error
  Lgrps<group_k_t>=The structure completely initialized.

TODO

   This is a stub. I still have to complete the fileformat for the Bilbao database.

SOURCE

672 subroutine groupk_from_file(Lgrps,spgroup,fname,nkpt,klist,ierr)
673 
674  implicit none
675 
676 !Arguments ------------------------------------
677 !scalars
678  integer,intent(in) :: spgroup
679  integer,intent(out) :: ierr,nkpt
680  character(len=fnlen),intent(in) :: fname
681 !arrays
682  type(group_k_t),target,allocatable :: Lgrps(:)
683  real(dp),pointer :: klist(:,:)
684 
685 !Local variables-------------------------------
686 !scalars
687  integer,parameter :: last_file_version=1
688  integer :: unt,fvers,ik,nsym_ltgk,isym,nirreps_k,irp,icls
689  integer :: irrep_idx,irrep_dim,sym_idx,ita_spgroup,nels,prev,now
690  character(len=IRREPNAME_LEN) :: irrep_name
691  character(len=1) :: basis
692  character(len=500) :: msg
693  type(group_k_t),pointer :: Gk
694 !arrays
695  integer,allocatable :: nelements(:),elements_idx(:,:)
696  real(dp) :: kpt(3)
697  character(len=10),allocatable :: kname(:)
698  type(irrep_t),pointer :: OneIrr
699 
700 ! *************************************************************************
701 
702  ierr=0
703  if (open_file(fname,msg,newunit=unt,form="formatted") /=0) then
704    ABI_ERROR(msg)
705  end if
706 
707  read(unt,*,ERR=10)          ! Skip the header.
708  read(unt,*,ERR=10) fvers    ! File version.
709  if (fvers > last_file_version) then
710    write(msg,"(2(a,i0))")" Found file format= ",fvers," but the latest supported version is: ",last_file_version
711    ABI_ERROR(msg)
712  end if
713  read(unt,*,ERR=10) ita_spgroup
714  read(unt,*,ERR=10) basis
715 
716  if (spgroup/=ita_spgroup) then
717    write(msg,'(a,2i0)')&
718 &   " Input space group does not match with the value reported on file: ",spgroup,ita_spgroup
719    ABI_ERROR(msg)
720  end if
721 
722  if (basis /= "b") then
723    msg=" Wrong value for basis: "//TRIM(basis)
724    ABI_ERROR(msg)
725  end if
726 
727  ! * Read the list of the k-points.
728  read(unt,*,ERR=10) nkpt
729 
730  ABI_MALLOC(Lgrps,(nkpt))
731 
732  ABI_MALLOC(klist,(3,nkpt))
733  ABI_MALLOC(kname,(nkpt))
734  do ik=1,nkpt
735    read(unt,*,ERR=10) klist(:,ik), kname(ik)
736  end do
737 
738  ! * Read tables for each k-point
739  do ik=1,nkpt
740 
741    read(unt,*,ERR=10) kpt
742    read(unt,*,ERR=10) nsym_ltgk
743    Gk  => Lgrps(ik)
744 
745    Gk%spgroup = ita_spgroup
746    Gk%nsym    = nsym_ltgk
747    Gk%point   = kpt
748    ABI_MALLOC(Gk%sym,(3,3,nsym_ltgk))
749    ABI_MALLOC(Gk%tnons,(3,nsym_ltgk))
750 
751    do isym=1,nsym_ltgk ! Read symmetries of the little group.
752      read(unt,*,ERR=10) Gk%sym(:,:,isym)
753      read(unt,*,ERR=10) Gk%tnons(:,isym)
754    end do
755 
756    ABI_MALLOC(nelements,(nsym_ltgk))
757    ABI_MALLOC(elements_idx,(nsym_ltgk,nsym_ltgk))
758 
759    call get_classes(nsym_ltgk,Gk%sym,Gk%nclass,nelements,elements_idx)
760 
761    ! The operations reported on the file are supposed to be packed in classes
762    ! otherwise one should perform a rearrangement of the indices.
763    prev = 0
764    do icls=1,Gk%nclass
765      do isym=1,nelements(icls)
766        now = elements_idx(isym,icls)
767        if ( (now-prev) /= 1 ) then
768          write(msg,"(2(a,i0))")&
769 &          " Symmetries on file are not ordered in classes. icls= ",icls,", isym= ",isym
770          ABI_ERROR(msg)
771        else
772          prev = now
773        end if
774      end do
775    end do
776 
777    ABI_MALLOC(Gk%class_ids,(2,Gk%nclass))
778    do icls=1,Gk%nclass
779      nels = nelements(icls)
780      Gk%class_ids(1,icls) = elements_idx(1,   icls)
781      Gk%class_ids(2,icls) = elements_idx(nels,icls)
782    end do
783 
784    ABI_FREE(nelements)
785    ABI_FREE(elements_idx)
786 
787    ! Read the irreducible representations.
788    read(unt,*,ERR=10) nirreps_k
789    ABI_CHECK(Gk%nclass == nirreps_k,"Gk%nclass /= nirreps_k")
790 
791    !$$ allocate(Gk%class_names(Gk%nclass))
792    ABI_MALLOC(Gk%Irreps,(nirreps_k))
793 
794    do irp=1,nirreps_k
795      OneIrr =>  Gk%Irreps(irp)
796      read(unt,*,ERR=10) irrep_idx, irrep_dim, irrep_name
797      call init_irrep(OneIrr,nsym_ltgk,irrep_dim,irrep_name)
798      do isym=1,nsym_ltgk
799        read(unt,*,ERR=10) sym_idx, OneIrr%mat(:,:,isym)
800        ABI_CHECK(sym_idx==irp,"sym_idx/=irp!")
801        ! Matrix elements on file are in the form (rho, theta) with theta given in degrees.
802        call cmplx_sphcart(OneIrr%mat(:,:,isym),from="Sphere",units="Degrees")
803        OneIrr%trace(isym) = get_trace(OneIrr%mat(:,:,isym))
804      end do
805    end do
806 
807  end do
808 
809  close(unt)
810  RETURN
811  !
812  ! Handle IO-error.
813 10 ierr=1
814  close(unt)
815  RETURN
816 
817 end subroutine groupk_from_file

m_ptgroups/init_irrep [ Functions ]

[ Top ] [ m_ptgroups ] [ Functions ]

NAME

  alloc_irrep

FUNCTION

  Initialize an instance of the irrep_t datatype.

INPUTS

  nsym=The number of symmetries.
  irr_dim=The dimension of the irrep.
  [irr_name]=The name of theirrep. "???" is used if not given

OUTPUT

  Irrep<irrep_t>=

SOURCE

959 subroutine init_irrep(Irrep,nsym,irr_dim,irr_name)
960 
961  implicit none
962 
963 !Arguments ------------------------------------
964 !scalars
965  integer,intent(in) :: nsym
966 !arrays
967  integer,intent(in) :: irr_dim
968  character(len=*),optional,intent(in) :: irr_name
969  type(irrep_t),intent(inout) :: Irrep
970 
971 !Local variables-------------------------------
972  !character(len=500) :: msg
973 ! *********************************************************************
974 
975  !@irrep_t
976  Irrep%dim      = irr_dim
977  Irrep%nsym     = nsym
978  Irrep%name     = "???"
979  if (PRESENT(irr_name)) Irrep%name = irr_name
980 
981  ABI_MALLOC(Irrep%mat,(irr_dim,irr_dim,nsym))
982  Irrep%mat = czero
983 
984  ABI_MALLOC(Irrep%trace,(nsym))
985  Irrep%trace = czero
986 
987 end subroutine init_irrep

m_ptgroups/irrep_free_0d [ Functions ]

[ Top ] [ m_ptgroups ] [ Functions ]

NAME

 irrep_free_0d

FUNCTION

  Deallocate all memory allocated in the irrep_t datatype.

SOURCE

831 subroutine irrep_free_0d(Irrep)
832 
833  implicit none
834 
835 !Arguments ------------------------------------
836  type(irrep_t),intent(inout) :: Irrep
837 
838 ! *********************************************************************
839 
840  !@irrep_t
841  if (allocated(Irrep%trace))  then
842    ABI_FREE(Irrep%trace)
843  end if
844  if (allocated(Irrep%mat))  then
845    ABI_FREE(Irrep%mat)
846  end if
847 
848 end subroutine irrep_free_0d

m_ptgroups/irrep_free_1d [ Functions ]

[ Top ] [ m_ptgroups ] [ Functions ]

NAME

 irrep_free_1d

FUNCTION

  Deallocate all memory allocated in the irrep_t datatype.

SOURCE

862 subroutine irrep_free_1d(Irrep)
863 
864  implicit none
865 
866 !Arguments ------------------------------------
867  type(irrep_t),intent(inout) :: Irrep(:)
868 
869 !Local variables-------------------------------
870  integer :: irp
871 ! *********************************************************************
872 
873  do irp=1,SIZE(Irrep)
874    call irrep_free_0d(Irrep(irp))
875  end do
876 
877 end subroutine irrep_free_1d

m_ptgroups/locate_sym [ Functions ]

[ Top ] [ m_ptgroups ] [ Functions ]

NAME

  locate_sym

FUNCTION

  Given a symmetry operation asym, this routine returns its index in the Ptg%sym
  array and the index of the class it belongs to.

INPUTS

OUTPUT

SOURCE

537 subroutine locate_sym(Ptg,asym,sym_idx,cls_idx,ierr)
538 
539  implicit none
540 
541 !Arguments ------------------------------------
542 !scalars
543  integer,intent(out) :: sym_idx,cls_idx
544  integer,optional,intent(out) :: ierr
545  type(point_group_t),intent(in) :: Ptg
546 !arrays
547  integer,intent(in) :: asym(3,3)
548 
549 !Local variables-------------------------------
550 !scalars
551  integer :: isym,icls
552  character(len=500) :: msg
553 
554 ! *********************************************************************
555 
556  sym_idx = 0
557  do isym=1,Ptg%nsym
558    if (ALL(asym == Ptg%sym(:,:,isym) )) then
559      sym_idx = isym
560      EXIT
561    end if
562  end do
563 
564  cls_idx = 0
565  do icls=1,Ptg%nclass
566    if (sym_idx >= Ptg%class_ids(1,icls) .and. &
567 &      sym_idx <= Ptg%class_ids(2,icls) ) then
568      cls_idx = icls
569      EXIT
570    end if
571  end do
572 
573  if (PRESENT(ierr)) ierr=0
574  if (sym_idx==0 .or. cls_idx==0) then
575    write(msg,'(a,9(i0,1x),3a,i1,a,i1)')&
576 &    " Symmetry: ",asym," not found in point group table ",ch10,&
577 &    " sym_idx= ",sym_idx, " and cls_idx= ",cls_idx
578    if (PRESENT(ierr)) then
579      ierr=1
580      ABI_WARNING(msg)
581    else
582      ABI_ERROR(msg)
583    end if
584  end if
585 
586 end subroutine locate_sym

m_ptgroups/mult_table [ Functions ]

[ Top ] [ m_ptgroups ] [ Functions ]

NAME

 mult_table

FUNCTION

  Given a set of nsym 3x3 operations which are supposed to form a group,
  this routine constructs the multiplication table of the group.

INPUTS

 nsym=number of symmetry operation
 sym(3,3,nsym)=the operations

OUTPUT

  mtab(nsym,nsym)=The index of the product S_i * S_j in the input set sym.

SOURCE

608 subroutine mult_table(nsym,sym,mtab)
609 
610  implicit none
611 
612 !Arguments ------------------------------------
613 !scalars
614  integer,intent(in) :: nsym
615 !arrays
616  integer,intent(in) :: sym(3,3,nsym)
617  integer,intent(out) :: mtab(nsym,nsym)
618 
619 !Local variables-------------------------------
620 !scalars
621  integer :: isym,jsym,ksym
622  !character(len=500) :: msg
623 !arrays
624  integer :: prod_ij(3,3),found(nsym)
625 
626 !************************************************************************
627 
628  do jsym=1,nsym
629    found(:)=0 ! Each symmetry should compare only once in a given (row|col).
630 
631    do isym=1,nsym
632      prod_ij = MATMUL(sym(:,:,isym),sym(:,:,jsym))
633      do ksym=1,nsym
634        if ( ALL(prod_ij == sym(:,:,ksym)) ) then
635          found(ksym)=found(ksym)+1
636          mtab(isym,jsym) = ksym
637        end if
638      end do
639    end do ! jsym
640 
641    if ( ANY(found /= 1)) then
642      write(std_out,*)"found = ",found
643      ABI_ERROR("Input elements do not form a group")
644    end if
645  end do ! isym
646 
647 end subroutine mult_table

m_ptgroups/point_group_free [ Functions ]

[ Top ] [ m_ptgroups ] [ Functions ]

NAME

 point_group_free

FUNCTION

  Deallocate all memory allocated in the point_group_t datatype.

SOURCE

374 subroutine point_group_free(Ptg)
375 
376  implicit none
377 
378 !Arguments ------------------------------------
379  type(point_group_t),intent(inout) :: Ptg
380 
381 !Local variables-------------------------------
382 ! *********************************************************************
383 
384  !@point_group_t
385  if (allocated(Ptg%class_ids))   then
386    ABI_FREE(Ptg%class_ids)
387  end if
388  if (allocated(Ptg%sym)) then
389    ABI_FREE(Ptg%sym)
390  end if
391  if (allocated(Ptg%class_names)) then
392    ABI_FREE(Ptg%class_names)
393  end if
394 
395  if (allocated(Ptg%Irreps)) then
396    call irrep_free(Ptg%Irreps)
397    ABI_FREE(Ptg%Irreps)
398  end if
399 
400 end subroutine point_group_free

m_ptgroups/point_group_init [ Functions ]

[ Top ] [ m_ptgroups ] [ Functions ]

NAME

 point_group_init

FUNCTION

  Creation method for the point_group_t datatype.

INPUTS

  ptg_name=The name of the point group (International conventions).

OUTPUT

  The datatype completely initialized.

SOURCE

421 subroutine point_group_init(Ptg,ptg_name)
422 
423  implicit none
424 
425 !Arguments ------------------------------------
426 !scalars
427  character(len=5),intent(in) :: ptg_name
428  type(point_group_t),intent(inout) :: Ptg
429 ! *********************************************************************
430 
431  !@point_group_t
432  !call wrtout(std_out," Retrieving point group data for: "//TRIM(ptg_name),"COLL")
433 
434  Ptg%gname = ptg_name
435  call get_point_group(Ptg%gname,Ptg%nsym,Ptg%nclass,Ptg%sym,Ptg%class_ids,Ptg%class_names,Ptg%Irreps)
436 
437 end subroutine point_group_init

m_ptgroups/point_group_print [ Functions ]

[ Top ] [ m_ptgroups ] [ Functions ]

NAME

 point_group_print

FUNCTION

INPUTS

OUTPUT

SOURCE

454 subroutine point_group_print(Ptg,header,unit,mode_paral,prtvol)
455 
456  implicit none
457 
458 !Arguments ------------------------------------
459 !scalars
460  integer,optional,intent(in) :: unit,prtvol
461  character(len=4),optional,intent(in) :: mode_paral
462  character(len=*),optional,intent(in) :: header
463  type(point_group_t),target,intent(in) :: Ptg
464 
465 !Local variables-------------------------------
466  integer :: my_unt,my_prtvol,irp,icls,sidx
467  complex(dpc) :: trace
468  character(len=4) :: my_mode
469  character(len=500) :: msg
470  type(irrep_t),pointer :: Row
471 ! *********************************************************************
472 
473  my_unt   =std_out; if (PRESENT(unit      )) my_unt   =unit
474  my_prtvol=0      ; if (PRESENT(prtvol    )) my_prtvol=prtvol
475  my_mode  ='COLL' ; if (PRESENT(mode_paral)) my_mode  =mode_paral
476 
477  msg=' ==== Point Group Table ==== '
478  if (PRESENT(header)) msg=' ==== '//TRIM(ADJUSTL(header))//' ==== '
479  call wrtout(my_unt,msg,my_mode)
480 
481  write(std_out,*)REPEAT("=",80)
482  write(std_out,*)" Point group : ",TRIM(Ptg%gname)," Number of symmetries ",Ptg%nsym," Number of classes    ",Ptg%nclass
483 
484  write(std_out,"(a6)",advance="no")"Class "
485  do icls=1,Ptg%nclass
486    write(std_out,"('|',a10)",advance="no")Ptg%class_names(icls)
487  end do
488  write(std_out,"('|')",advance="no")
489  write(std_out,*)" "
490 
491  write(std_out,"(a6)",advance="no")"Mult  "
492  do icls=1,Ptg%nclass
493    write(std_out,"('|',i10)",advance="no")Ptg%class_ids(2,icls)-Ptg%class_ids(1,icls) + 1
494  end do
495  write(std_out,"('|')",advance="no")
496  write(std_out,*)" "
497 
498  do irp=1,SIZE(Ptg%Irreps)
499    Row =>  Ptg%Irreps(irp)
500    write(std_out,'(a6)',advance="no")TRIM(Row%name)
501 
502    do icls=1,Ptg%nclass
503      sidx = Ptg%class_ids(1,icls)
504      trace = Row%trace(sidx)
505      if (ABS(AIMAG(trace)) > tol6) then
506         write(std_out,"('|',(2f5.2))",advance="no")trace
507       else
508         write(std_out,"('|',(f10.2))",advance="no")REAL(trace)
509       end if
510    end do
511 
512    write(std_out,"('|')",advance="no")
513    write(std_out,*)" "
514  end do
515 
516  write(std_out,*)REPEAT("=",80)
517 
518 end subroutine point_group_print

m_ptgroups/show_character_tables [ Functions ]

[ Top ] [ m_ptgroups ] [ Functions ]

NAME

  show_character_tables

FUNCTION

   Printout of the caracter tables of the 32 point groups.

INPUTS

  [unit]=Unit number of output file. Defaults to std_out

OUTPUT

  Only writing.

SOURCE

331 subroutine show_character_tables(unit)
332 
333  implicit none
334 
335 !Arguments ------------------------------------
336 !scalars
337  integer,optional,intent(in) :: unit
338 
339 !Local variables-------------------------------
340  integer :: igrp,my_unt
341  character(len=5) :: ptg_name
342  type(point_group_t) :: Ptg
343 !arrays
344  !integer,allocatable :: elements_idx(:,:),nelements(:)
345 
346 ! *********************************************************************
347 
348  my_unt = std_out; if (PRESENT(unit)) my_unt=unit
349 
350  do igrp=1,SIZE(ptgroup_names)
351    ptg_name = ptgroup_names(igrp)
352    call point_group_init(Ptg,ptg_name)
353    call point_group_print(Ptg,unit=my_unt)
354    !allocate(nelements(Ptg%nsym),elements_idx(Ptg%nsym,Ptg%nsym))
355    !call get_classes(Ptg%nsym,Ptg%sym,nclass,nelements,elements_idx)
356    !deallocate(nelements,elements_idx)
357    call point_group_free(Ptg)
358  end do
359 
360 end subroutine show_character_tables

m_ptgroups/sum_irreps [ Functions ]

[ Top ] [ m_ptgroups ] [ Functions ]

NAME

  sum_irreps

FUNCTION

INPUTS

OUTPUT

SOURCE

1004 function sum_irreps(Irrep1,Irrep2,ii,jj,kk,ll) result(res)
1005 
1006  implicit none
1007 
1008 !Arguments ------------------------------------
1009 !scalars
1010  integer,intent(in) :: ii,jj,kk,ll
1011 !arrays
1012  type(irrep_t),intent(in) :: Irrep1,Irrep2
1013  complex(dpc) :: res
1014 
1015 !Local variables-------------------------------
1016  integer :: isym,nsym,ierr
1017  !character(len=500) :: msg
1018 ! *********************************************************************
1019 
1020  ierr=0; res = czero
1021 
1022  nsym = Irrep1%nsym
1023  if (nsym /= Irrep2%nsym) then
1024    ABI_WARNING("Irreps have different nsym")
1025    ierr=ierr+1
1026  end if
1027 
1028  if (Irrep1%dim /= Irrep2%dim) then
1029    ABI_WARNING("Irreps have different dimensions")
1030    write(std_out,*)Irrep1%dim,Irrep2%dim
1031    ierr=ierr+1
1032  end if
1033 
1034  if (ii>Irrep2%dim .or. jj>Irrep2%dim .or. &
1035 &    kk>Irrep1%dim .or. ll>Irrep1%dim) then
1036    ABI_WARNING("Wrong indices")
1037    write(std_out,*)ii,Irrep2%dim,jj,Irrep2%dim,kk>Irrep1%dim,ll,Irrep1%dim
1038    ierr=ierr+1
1039  end if
1040 
1041  if (ierr/=0) RETURN
1042 
1043  do isym=1,nsym
1044    res = res + DCONJG(Irrep1%mat(ii,jj,isym)) * Irrep2%mat(kk,ll,isym)
1045  end do
1046 
1047 end function sum_irreps