LCOV - code coverage report
Current view: top level - inpgen - generator.f (source / functions) Hit Total Coverage
Test: combined.info Lines: 85 107 79.4 %
Date: 2019-09-08 04:53:50 Functions: 1 1 100.0 %

          Line data    Source code
       1             :       MODULE m_generator
       2             :       use m_juDFT
       3             : !***********************************************************************
       4             : !     determines a set of generators for the group defined by the
       5             : !     nops matrices mrot. the set is not unique.
       6             : !***********************************************************************
       7             :       CONTAINS
       8           3 :       SUBROUTINE generator(
       9           3 :      >                     nops,mrot,tau,outfh,errfh)
      10             : 
      11             :       USE m_closure, ONLY : close_pt
      12             : 
      13             :       IMPLICIT NONE
      14             : 
      15             : !==> Arguments
      16             :       INTEGER, INTENT (IN) :: nops,outfh,errfh
      17             :       INTEGER, INTENT (IN) :: mrot(3,3,nops)
      18             :       REAL,    INTENT (IN) :: tau(3,nops)
      19             : 
      20             : !==> Locals
      21             :       INTEGER i,j,k,n,ngen,nops_sub,ncyl,ncl(1)
      22           6 :       INTEGER igenerator(nops)
      23          12 :       INTEGER mtable(nops,nops),nrow(nops)
      24          18 :       INTEGER trace(nops),mdet(nops),mtrd(nops)
      25           6 :       INTEGER nfactor(nops)
      26             : 
      27             : !--->    for trivial cases, print out and end
      28             : 
      29           3 :       IF ( nops .eq. 1 ) THEN
      30             :          WRITE (outfh,'(//," Space group can be generated using the",
      31           0 :      &                " identity only (no generators)")')
      32             :          RETURN
      33             :       ENDIF
      34             : 
      35             : !--->    generate multiplication table
      36             :       CALL close_pt(
      37             :      >              nops,mrot,
      38           3 :      <              mtable)
      39             : 
      40           3 :       IF ( nops .eq. 2 ) then
      41           0 :         ngen = 1
      42           0 :         igenerator(1) = nops
      43           0 :         GOTO 200
      44             :       ENDIF
      45             : 
      46             : !--->    determine the trace and determinant of each operation
      47         291 :       DO n=1,nops
      48         144 :          trace(n) = mrot(1,1,n) + mrot(2,2,n) + mrot(3,3,n)
      49             :          mdet(n) =
      50             :      &    mrot(1,1,n)*(mrot(2,2,n)*mrot(3,3,n)-mrot(3,2,n)*mrot(2,3,n))
      51             :      &   +mrot(1,2,n)*(mrot(3,1,n)*mrot(2,3,n)-mrot(2,1,n)*mrot(3,3,n))
      52         144 :      &   +mrot(1,3,n)*(mrot(2,1,n)*mrot(3,2,n)-mrot(3,1,n)*mrot(2,2,n))
      53         147 :          mtrd(n) = trace(n)*mdet(n)
      54             :       ENDDO
      55             : 
      56           3 :       ngen = 0
      57           3 :       nops_sub = nops
      58         147 :       nfactor(1:nops) = 1
      59             : 
      60             : !--->    check whether inversion exits (tr = -3); if so, a generator
      61         291 :       DO n=1,nops
      62         147 :          IF ( trace(n) == -3 ) THEN
      63           3 :             ngen = ngen + 1
      64           3 :             igenerator(ngen) = n
      65           3 :             nops_sub = nops_sub/2
      66         147 :             WHERE ( mdet == -1 ) nfactor = 0  ! get factor group
      67             :          ENDIF
      68             :       ENDDO
      69             : 
      70             : !--->    look for first 6, bar{6} operation
      71           3 :       IF ( mod(nops_sub,6) == 0 ) THEN
      72         291 :          DO n=1,nops
      73         147 :             IF ( (nfactor(n)==1) .and. (abs(trace(n))==2) ) THEN
      74           0 :                ngen = ngen + 1
      75           0 :                igenerator(ngen) = n
      76           0 :                nops_sub = nops_sub/6
      77           0 :                EXIT
      78             :             ENDIF
      79             :          ENDDO
      80             :       ENDIF
      81             : 
      82             : !--->    get first 3-fold axis not yet included
      83           3 :       IF ( mod(nops_sub,3) == 0 ) THEN
      84          57 :          DO n=1,nops
      85           0 :             IF ( (nfactor(n)==1) .and. (trace(n)==0) ) THEN
      86           3 :                ngen = ngen + 1
      87           3 :                igenerator(ngen) = n
      88           3 :                nops_sub = nops_sub/3
      89           3 :                EXIT
      90             :             ENDIF
      91             :          ENDDO
      92             :       ENDIF
      93             : 
      94             : !--->    get first 4-fold axis not yet included;
      95             : !--->    for cubic case, do not use, use 2 and m instead
      96          27 :       IF ( ( mod(nops_sub,4) == 0 ) .and. ( any(mtrd == 1) ) ) then
      97           3 :          IF ( nops < 24 ) THEN
      98           0 :             DO n=1,nops
      99           0 :                IF ( (nfactor(n)==1) .and. (mtrd(n)==1) ) THEN
     100           0 :                   ngen = ngen + 1
     101           0 :                   igenerator(ngen) = n
     102           0 :                   nops_sub = nops_sub/4
     103           0 :                   EXIT
     104             :                ENDIF
     105             :             ENDDO
     106             :          ELSE   ! cubic case: give the C_4 in terms of C_3 and m
     107           3 :             k = igenerator(ngen)  ! the 3-fold generator
     108           3 :             nrow(:) = mtable(:,k)
     109             :             ncyl = 0
     110         225 :             DO n=1,nops           ! loop over the 3-fold rotations
     111           3 :                IF ( (nfactor(n)==1) .and. (trace(n)==0) ) THEN
     112             : !-->                              ! find j such that n=mtable(j,k)
     113         351 :                    ncl = maxloc( nrow , MASK = nrow .eq. n )
     114          18 :                    if( mtrd(ncl(1)) == -1 ) then
     115           6 :                      ncyl = ncyl + 1
     116           6 :                      ngen = ngen + 1
     117           6 :                      igenerator(ngen) = ncl(1)
     118           6 :                      nops_sub = nops_sub/2
     119           6 :                      IF ( ncyl .ge. 2) EXIT
     120             :                    ENDIF
     121             :                ENDIF
     122             :             ENDDO
     123             :          ENDIF
     124             :       ENDIF
     125             : 
     126             : !--->    generate group determined by generators up to now
     127         147 :       nfactor = 0
     128           3 :       nfactor(1) = 1
     129             : 
     130          15 :       DO i=1,ngen
     131             :          k=1
     132         588 :          nrow = nfactor
     133             :          DO   ! multiply
     134          27 :             k = mtable( igenerator(i), k )
     135          27 :             IF ( k == 1 ) EXIT
     136         732 :             DO j=1,nops
     137          15 :                IF ( nfactor(j) == 1 ) THEN
     138          69 :                   nrow( mtable(k,j) ) = 1
     139             :                ENDIF
     140             :             ENDDO
     141             : 
     142             :          ENDDO
     143         591 :          nfactor = nrow
     144             :       ENDDO
     145             : 
     146             : !--->    at this point, only operations left to consider are 2, m
     147             : !--->    nfactor contains the elements of the factor group to this point
     148             : 
     149             :       DO
     150           6 :          IF ( nops_sub == 1 ) EXIT
     151             : !--->       check for first 2 or m operation not yet included
     152         147 :          nrow = nfactor
     153           9 :          DO n=1,nops
     154           6 :             IF ( (nfactor(n)==0) .and. (mtrd(n) == -1) ) THEN
     155           3 :                ngen = ngen + 1
     156           3 :                igenerator(ngen) = n
     157           3 :                nops_sub = nops_sub/2
     158         147 :                DO j=1,nops             ! generate larger group
     159           3 :                   if( nfactor(j) == 1 ) nrow( mtable(n,j) ) = 1
     160             :                ENDDO
     161             :                EXIT
     162             :             ENDIF
     163           0 :   100       CONTINUE
     164             :          ENDDO
     165         147 :          nfactor = nrow
     166             :       ENDDO
     167             : 
     168             :  200  CONTINUE
     169             : 
     170             : !--->    output
     171             : 
     172           3 :       IF (ngen == 1 ) THEN
     173             :          WRITE (outfh,'(//," Space group can be generated using",i2,
     174           0 :      &                " generator: ",10i4)') ngen,igenerator(1:ngen)
     175           0 :          WRITE (outfh,'(/,"   generator  (in lattice coordinates):")')
     176             :       ELSE
     177             :          WRITE (outfh,'(//," Space group can be generated using",i2,
     178           3 :      &                " generators:",10i4)') ngen,igenerator(1:ngen)
     179           3 :          WRITE (outfh,'(/,"   generators (in lattice coordinates):")')
     180             :       ENDIF
     181           3 :       WRITE (outfh,'(/,"&gen",i10)') ngen
     182          18 :       DO n=1,ngen
     183          15 :          WRITE (outfh,*)
     184             :          WRITE (outfh,'(3i5,5x,f10.5)') 
     185          18 :      &  ( ( mrot(i,j,igenerator(n)),j=1,3 ),tau(i,igenerator(n)),i=1,3 )
     186             :       ENDDO
     187           3 :       WRITE (outfh,'(/,"/ ! end generators",/)')
     188             : 
     189             : !--->    test to make sure the generators do generate the group
     190         147 :       nfactor = 0
     191           3 :       nfactor(1) = 1
     192          18 :       DO n=1,ngen
     193             :          k=1
     194         735 :          nrow = nfactor
     195             :          DO   ! multiply
     196          33 :             k = mtable( igenerator(n), k )
     197          33 :             if( k == 1 ) exit
     198         879 :             DO j=1,nops
     199          18 :                IF ( nfactor(j) == 1 ) THEN
     200         141 :                   i = mtable(k,j)
     201         141 :                   IF ( nrow(i) == 0 ) THEN
     202         141 :                      nrow( i ) = 1
     203             :                   ELSE
     204           0 :                      WRITE (errfh,'("generators: Error: multiple ops")')
     205             :                      CALL juDFT_error("Multiple ops.",calledby
     206           0 :      +                    ="generator")
     207             :                   ENDIF
     208             :                ENDIF
     209             :             ENDDO
     210             :          ENDDO
     211         738 :          nfactor = nrow
     212             :       ENDDO
     213         147 :       IF ( any(nfactor == 0) ) THEN
     214           0 :          WRITE (errfh,'("generators: Error: Group not covered")')
     215           0 :          CALL juDFT_error("Group not covered.",calledby ="generator")
     216             :       ENDIF
     217             : 
     218             :       END SUBROUTINE generator
     219             :       END MODULE m_generator

Generated by: LCOV version 1.13