1!
2! Copyright (C) 2001-2010 Quantum ESPRESSO group
3! This file is distributed under the terms of the
4! GNU General Public License. See the file `License'
5! in the root directory of the present distribution,
6! or http://www.gnu.org/copyleft/gpl.txt .
7!
8!
9!-----------------------------------------------------------------------
10SUBROUTINE multable( nsym, s, table )
11  !-----------------------------------------------------------------------
12  !! Checks that {S} is a group and calculates multiplication table
13  !
14  IMPLICIT NONE
15  !
16  INTEGER, INTENT(IN) :: nsym
17  !! the number of symmetry operations
18  INTEGER, INTENT(IN) :: s(3,3,nsym)
19  !! rotation matrix (in crystal axis, represented by integers)
20  INTEGER, INTENT(OUT) :: table(48,48)
21  ! multiplication table:  S(n)*S(m) = S( table(n,m) )
22  !
23  ! ... local variables
24  !
25  INTEGER :: isym, jsym, ksym, ss(3,3)
26  LOGICAL :: found, smn
27  !
28  !
29  DO isym = 1, nsym
30     DO jsym = 1, nsym
31        !
32        ss = MATMUL( s(:,:,jsym), s(:,:,isym) )
33        !
34        ! ... here we check that the input matrices really form a group
35        !     and we set the multiplication table
36        !
37        found = .FALSE.
38        DO ksym = 1, nsym
39           smn =  ALL( s(:,:,ksym) == ss(:,:) )
40           IF (smn) THEN
41              IF (found) CALL errore( 'multable', 'Not a group', 1 )
42              found = .TRUE.
43              table (jsym,isym) = ksym
44           ENDIF
45        ENDDO
46        IF ( .NOT. found) CALL errore( 'multable', ' Not a group', 2 )
47        !
48     ENDDO
49  ENDDO
50  !
51  !
52  RETURN
53  !
54END SUBROUTINE multable
55