LCOV - code coverage report
Current view: top level - init - spg2set.f (source / functions) Hit Total Coverage
Test: combined.info Lines: 71 84 84.5 %
Date: 2019-09-08 04:53:50 Functions: 1 1 100.0 %

          Line data    Source code
       1             : !--------------------------------------------------------------------------------
       2             : ! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
       3             : ! This file is part of FLEUR and available as free software under the conditions
       4             : ! of the MIT license as expressed in the LICENSE file in more detail.
       5             : !--------------------------------------------------------------------------------
       6             : 
       7             :       MODULE m_spg2set
       8             :       use m_juDFT
       9             : !-------------------------------------------------------------------------+
      10             : ! determine the rotation martrices (mrot) and non-symorphic translations  !
      11             : ! for a given 2D symmetry (defined by a number n2spg) plus eventually     !
      12             : ! inversion (invs) or z-reflection (zrfs) symmetry.                       !
      13             : ! Plane groups 1-17 are according to Int. Tables of Crystallography       !
      14             : ! 18-20 : pm, pg and cm with mirror plane y -> -y  (as used in old spgset)!
      15             : ! 21-25 : p3, p3m1, p31m, p6 and p6mm  with sharp angle (lattice type hex)!
      16             : !                                                                   gb`02 !
      17             : !-------------------------------------------------------------------------+
      18             :       CONTAINS
      19          18 :       SUBROUTINE spg2set(
      20             :      >                   nop,zrfs,invs,namgrp,latnam,
      21          18 :      <                   mrot,tau,nop2,symor)
      22             : 
      23             :       USE m_symdata, ONLY : gen2,tau2,spg2,gnt2,namgr2,nammap,ord2
      24             :       USE m_matmul,ONLY   : matmul4
      25             :       IMPLICIT NONE
      26             : 
      27             :       INTEGER, INTENT (IN) :: nop
      28             :       LOGICAL, INTENT (IN) :: invs,zrfs
      29             :       CHARACTER(len=4),INTENT (IN) :: namgrp
      30             :       CHARACTER(len=3),INTENT (IN) :: latnam
      31             : 
      32             :       INTEGER, INTENT (OUT) :: nop2
      33             :       INTEGER, INTENT (OUT) :: mrot(3,3,nop)
      34             :       REAL,    INTENT (OUT) :: tau(3,nop)
      35             :       LOGICAL, INTENT (OUT) :: symor
      36             : 
      37             : 
      38             :       INTEGER n2spg, ngen, igen, n1, n2, n, i, j, d, t
      39          36 :       INTEGER mt(3,3), multab(nop)
      40             :       LOGICAL l_new
      41             :       CHARACTER(len=3) type
      42             : 
      43             : !mod: INTEGER spg2(3,25)             ! generators for 2d space groups
      44             : !mod: INTEGER gnt2(3,25)             ! translations for 2d space groups
      45             : !mod: INTEGER gen2(2,2,9)            ! rotation matrices for the generators 
      46             : !mod: REAL    tau2(2,3)              ! translations for the generators
      47             : !mod: CHARACTER(len=4) :: namgr2(25) ! names of 2d space groups
      48             : !
      49             : ! Determine number of 2d space group
      50             : !
      51         378 :       DO i = 1, 20
      52         378 :         IF (namgrp.EQ.nammap(i)) n2spg = i
      53             :       ENDDO
      54             :       IF ((latnam.EQ.'hex').AND.(n2spg.GT.12).
      55          18 :      +                      AND.(n2spg.LT.18)) THEN
      56           0 :         n2spg = n2spg + 8
      57             :       ENDIF
      58          18 :       IF (n2spg == 0)  CALL juDFT_error("2D-symmetry group not found!"
      59           0 :      +     ,calledby ="spg2set")
      60             : !
      61             : ! Determine number of generators ngen
      62             : !
      63          18 :       ngen = 1
      64          72 :       DO igen = 1, 3
      65          72 :         IF (spg2(igen,n2spg).NE.0) ngen = ngen + 1
      66             :       ENDDO
      67          18 :       nop2 = ord2(n2spg)
      68             : !
      69             : ! make 3d rotation matrices for the generators
      70             : !
      71          18 :       symor = .true.
      72          72 :       mrot(:,:,1) = reshape((/1,0,0,0,1,0,0,0,1/),(/3,3/))  ! Identity is the first generator
      73          72 :       tau(:,1) = 0.0
      74          66 :       DO igen = 2, ngen
      75          48 :         mrot(:,:,igen) = reshape((/0,0,0,0,0,0,0,0,1/),(/3,3/))
      76          48 :         mrot(1:2,1:2,igen) = gen2(1:2,1:2,spg2(igen-1,n2spg))
      77          48 :         tau(:,igen) =  0.0
      78          66 :         IF (gnt2(igen-1,n2spg).NE.0) THEN
      79           0 :           symor = .false.
      80           0 :           tau(1:2,igen) = tau2(1:2,gnt2(igen-1,n2spg)) 
      81             :         ENDIF
      82             :       ENDDO
      83             : !
      84             : ! now close the group
      85             : !
      86          18 :       mrot(:,:,ngen+1:nop) = 0 ; tau(:,ngen+1:nop) = 0.0
      87             :   10  CONTINUE
      88         852 :       rm1 : DO n1 = 1,ngen
      89        9910 :          rm2 : DO  n2 = 1,ngen
      90             : 
      91             :             !CALL matmul1(mrot(1,1,n1),mrot(1,1,n2),mt)
      92        9234 :             mt=matmul(mrot(:,:,n1),mrot(:,:,n2))
      93       65394 :             rm3 : DO n = 1,nop
      94      147118 :                DO i = 1,3
      95      387292 :                   DO j = 1,3
      96      237672 :                      IF (mt(i,j).NE.mrot(i,j,n)) CYCLE rm3
      97             :                   ENDDO
      98             :                ENDDO
      99       56336 :                CYCLE rm2
     100             :             ENDDO rm3
     101             : 
     102             : ! -->       new element found
     103         176 :             ngen = ngen + 1
     104         176 :             IF (ngen.gt.nop) THEN
     105           0 :                WRITE(6,'(a7,i4,a7,i4)') 'ngen = ',ngen,' nop = ',nop
     106           0 :                 CALL juDFT_error("ngen > nop",calledby="spg2set")
     107             :             ENDIF
     108             :            
     109             :             CALL matmul4(mrot(1,1,n1),tau(1,n1),
     110             :      >                   mrot(1,1,n2),tau(1,n2),
     111         176 :      <                   mrot(1,1,ngen),tau(1,ngen))
     112         818 :             GOTO 10
     113             : 
     114             :          ENDDO rm2
     115             :       ENDDO rm1
     116             : !
     117             : ! add inversion or z-reflection symmetry
     118             : !
     119          34 :       IF ( (nop2.EQ.ngen).AND.(zrfs.OR.invs) ) THEN
     120          16 :         l_new = .true.
     121          16 :         IF (invs) THEN
     122          16 :           ngen = ngen + 1
     123          16 :           mrot(:,:,ngen) = - mrot(:,:,1)                     ! I 
     124          16 :           tau(:,ngen) =  0.0
     125          16 :           IF (spg2(1,n2spg).EQ.2) l_new = .false.            ! if c_2 & I are generators
     126             :         ENDIF                                                ! m_z is no new generator
     127          16 :         IF (zrfs.AND.l_new) THEN
     128           0 :           ngen = ngen + 1
     129           0 :           mrot(:,:,ngen) =  reshape((/1,0,0,0,1,0,0,0,-1/),(/3,3/))  !m_z
     130           0 :           tau(:,ngen) =  0.0
     131             :         ENDIF
     132             :         GOTO 10                                              ! now close the 3D group
     133             :       ENDIF
     134             : !
     135             : ! Output the symmetry elements
     136             : !
     137          18 :       IF (nop.NE.ngen) THEN
     138           0 :           WRITE (6,*) 'nop =',nop,' =/= ngen = ',ngen
     139           0 :            CALL juDFT_error("nop =/= ngen",calledby="spg2set")
     140             :       ENDIF
     141          18 :       WRITE (6,FMT=8010) namgr2(n2spg),invs,zrfs,nop,symor
     142             :  8010 FORMAT (/,/,' space group: ',a4,' invs=',l1,' zrfs=',l1,/,
     143             :      +  ' number of operations=',i3,/,' symmorphic=',l1,/,/)
     144          18 :       WRITE (6,'("Number of 2D operations=",i3)') nop2
     145         276 :       DO n = 1,nop
     146             : !
     147             : ! Determine the kind of symmetry operation we have here
     148             : !
     149             :          d = mrot(1,1,n)*mrot(2,2,n)*mrot(3,3,n) + 
     150             :      +       mrot(1,2,n)*mrot(2,3,n)*mrot(3,1,n) +
     151             :      +       mrot(2,1,n)*mrot(3,2,n)*mrot(1,3,n) - 
     152             :      +       mrot(1,3,n)*mrot(2,2,n)*mrot(3,1,n) -
     153             :      +       mrot(2,3,n)*mrot(3,2,n)*mrot(1,1,n) - 
     154         258 :      +       mrot(2,1,n)*mrot(1,2,n)*mrot(3,3,n)
     155         258 :          t =  mrot(1,1,n) + mrot(2,2,n) + mrot(3,3,n)
     156             : 
     157         258 :          IF (d.EQ.-1) THEN
     158         128 :            type = 'm  '
     159         128 :            IF (t.EQ.-3) type = 'I  '
     160         130 :          ELSEIF (d.EQ.1) THEN
     161         130 :            IF (t.EQ.-1) type = 'c_2'
     162         130 :            IF (t.EQ. 0) type = 'c_3'
     163         130 :            IF (t.EQ. 1) type = 'c_4'
     164         130 :            IF (t.EQ. 2) type = 'c_6'
     165         130 :            IF (t.EQ. 3) type = 'E  '
     166             :          ELSE
     167           0 :             CALL juDFT_error("determinant=/=+/- 1",calledby ="spg2set")
     168             :          ENDIF
     169             : 
     170         258 :          WRITE (6,FMT=8020) n, type
     171             :  8020    FORMAT (/,1x,i3,' : ',a3)
     172        1050 :          DO i = 1,3
     173        1032 :             WRITE (6,FMT=8030) (mrot(i,j,n),j=1,3),tau(i,n)
     174             :          ENDDO
     175             :  8030    FORMAT (5x,3i3,3x,f4.1)
     176             :       ENDDO
     177             : c
     178             : c     check closure
     179             : c
     180          18 :       WRITE (6,FMT=8040)
     181             :  8040 FORMAT (/,/,' multiplication table',/,/)
     182             : 
     183         276 :       op1 : DO n1 = 1,nop
     184        4356 :          op2 : DO  n2 = 1,nop
     185             : 
     186             :             !CALL matmul1(mrot(1,1,n1),mrot(1,1,n2),mt)
     187        4098 :             mt=matmul(mrot(:,:,n1),mrot(:,:,n2))
     188       34818 :             op3 : DO n = 1,nop
     189       75790 :                DO i = 1,3
     190      198700 :                   DO j = 1,3
     191      122904 :                      IF (mt(i,j).NE.mrot(i,j,n)) CYCLE op3
     192             :                   ENDDO
     193             :                ENDDO
     194        4098 :                multab(n2) = n
     195        4098 :                CYCLE op2
     196             :             ENDDO op3
     197             : 
     198           0 :             WRITE (6,FMT=8050) n1,n2
     199             :  8050       FORMAT (' error - n1,n2=',2i3)
     200         258 :              CALL juDFT_error("mult",calledby="spg2set")
     201             :          ENDDO op2
     202         276 :          WRITE (6,FMT=8060) (multab(n),n=1,nop)
     203             :  8060    FORMAT (1x,48i2)
     204             :       ENDDO op1
     205             : 
     206          18 :       END SUBROUTINE spg2set
     207             :       END MODULE m_spg2set

Generated by: LCOV version 1.13