LCOV - code coverage report
Current view: top level - inpgen - closure.f90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 50 80 62.5 %
Date: 2019-09-08 04:53:50 Functions: 3 3 100.0 %

          Line data    Source code
       1             : MODULE m_closure
       2             : 
       3             : use m_juDFT
       4             : 
       5             : !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
       6             : !     Contains 3 subroutines that more or less check the closure:
       7             : !     closure :    checks whether the space group operations close
       8             : !     close_pt:    checks that the point group of the bravais 
       9             : !                  lattice closes
      10             : !     check_close: additionally calculate the multiplication table,
      11             : !                  inverse operations and also determines the type 
      12             : !                  of every operation                    mw99,gs00
      13             : !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      14             : 
      15             : CONTAINS
      16             : 
      17           3 : SUBROUTINE closure(mops,mrot,tau,nops,index_op,lclose)
      18             : 
      19             :    IMPLICIT NONE
      20             : 
      21             :    INTEGER, INTENT (IN)  :: mops           ! number of operations of the bravais lattice
      22             :    INTEGER, INTENT (IN)  :: nops           ! number of operations in space group
      23             :    INTEGER, INTENT (IN)  :: mrot(3,3,mops) ! refer to the operations of the 
      24             :    REAL,    INTENT (IN)  :: tau(3,mops)    ! bravais lattice
      25             :    INTEGER, INTENT (IN)  :: index_op(nops) ! mapping function between space group 
      26             :                                               ! op's and those of the bravais lattice
      27             :    LOGICAL, INTENT (OUT) :: lclose
      28             : 
      29             :    REAL    ttau(3),eps7
      30           6 :    INTEGER i,ii,j,jj,k,kk,mp(3,3),map(nops)
      31             : 
      32           3 :    eps7 = 1.0e-7
      33             : 
      34             :    ! loop over all operations
      35         147 :    DO jj = 1, nops
      36         144 :       j = index_op(jj)
      37             : 
      38        7056 :       map(1:nops) = 0
      39             : 
      40             :       ! multiply {R_j|t_j}{R_i|t_i}
      41        7059 :       DO ii = 1, nops
      42        6912 :          i = index_op(ii)
      43        6912 :          mp = matmul( mrot(:,:,j) , mrot(:,:,i) )
      44        6912 :          ttau = tau(:,j) + matmul( mrot(:,:,j) , tau(:,i) )
      45       27648 :          ttau = ttau - anint( ttau - eps7 )
      46             : 
      47             :          ! determine which operation this is
      48      338688 :          DO kk=1,nops
      49      331776 :             k = index_op(kk)
      50      338688 :             IF ( all( mp(:,:) == mrot(:,:,k) ) .AND. all( abs( ttau(:)-tau(:,k) ) < eps7 ) ) THEN
      51        6912 :                IF ( map(ii) .eq. 0 ) THEN
      52        6912 :                   map(ii) = kk
      53             :                ELSE
      54           0 :                   write(6,*)'ERROR Closure: Multiplying ', jj,' with ',kk, ' and with ',map(ii)
      55           0 :                   write(6,*) 'yields the same matrix'
      56           0 :                   lclose = .false.
      57           0 :                   RETURN
      58             :                END IF
      59             :             END IF
      60             :          END DO
      61             : 
      62        7056 :          IF (map(ii).eq.0) THEN
      63           0 :             write(6,*)'ERROR Closure:',ii,' times',jj,' leaves group'
      64           0 :             lclose = .false.
      65           0 :             RETURN
      66             :          END IF
      67             :       END DO
      68             :    END DO
      69             : 
      70           3 :    lclose = .true.
      71             : 
      72             : END SUBROUTINE closure
      73             : 
      74             : !*********************************************************************
      75             : 
      76           6 : SUBROUTINE close_pt(nops,mrot,mtable)
      77             : 
      78             :    IMPLICIT NONE
      79             : 
      80             :    INTEGER, INTENT (IN)  :: nops,mrot(3,3,nops)
      81             :    INTEGER, INTENT (OUT) :: mtable(nops,nops)   ! table(i,j) = {R_i|0}{R_j|0}
      82             : 
      83          12 :    INTEGER              :: i,j,k,mp(3,3),map(nops)
      84             : 
      85             :    ! loop over all operations
      86         294 :    DO j = 1, nops
      87             : 
      88       14112 :       map(1:nops) = 0
      89             : 
      90             :       ! multiply {R_j|0}{R_i|0}
      91       14112 :       DO i = 1, nops
      92       13824 :          mp = matmul( mrot(:,:,j) , mrot(:,:,i) )
      93             : 
      94             :          ! determine which operation this is
      95      677376 :          DO k = 1, nops
      96      677376 :             IF ( all( mp(:,:)==mrot(:,:,k) ) ) THEN
      97       13824 :                IF ( map(i) .eq. 0 ) THEN
      98       13824 :                   map(i) = k
      99             :                ELSE
     100           0 :                   WRITE (6,'(" Symmetry error : multiple ops")')
     101           0 :                   CALL juDFT_error("close_pt: Multiple ops (Bravais)",calledby ="closure")
     102             :                END IF
     103             :             END IF
     104             :          END DO
     105             : 
     106       14112 :          IF (map(i).eq.0) THEN
     107           0 :             WRITE(6,*) 'Symmetry operations:'
     108           0 :             DO k = 1, nops
     109           0 :                WRITE(6,*) 'Matrix ', k, ':'
     110           0 :                WRITE(6,'(3i7)') mrot(:,1,k)
     111           0 :                WRITE(6,'(3i7)') mrot(:,2,k)
     112           0 :                WRITE(6,'(3i7)') mrot(:,3,k)
     113           0 :                WRITE(6,*) ''
     114             :             END DO
     115           0 :             WRITE (6,'(" Group not closed (Bravais lattice)")')
     116           0 :             WRITE (6,'(" operation j=",i2,"  map=",12i4,:/,(21x,12i4))')  j, map(1:nops)
     117           0 :             WRITE(6,*) ''
     118           0 :             WRITE(6,*) 'Expected product of operations ', j, ' and ', i, ':'
     119           0 :             WRITE(6,'(3i7)') mp(:,1)
     120           0 :             WRITE(6,'(3i7)') mp(:,2)
     121           0 :             WRITE(6,'(3i7)') mp(:,3)
     122           0 :             WRITE(6,*) ''
     123           0 :             CALL juDFT_error("close_pt:Not closed",calledby="closure")
     124             :          END IF
     125             :       END DO
     126         294 :       mtable(j,1:nops) = map(1:nops)
     127             :    END DO
     128             : 
     129           6 : END SUBROUTINE close_pt
     130             : 
     131             : !*********************************************************************
     132             : 
     133          26 : SUBROUTINE check_close(nops,mrot,tau,multtab,inv_op,optype)
     134             : 
     135             :    IMPLICIT NONE
     136             : 
     137             :    INTEGER, INTENT (IN)  :: nops
     138             :    INTEGER, INTENT (IN)  :: mrot(3,3,nops)
     139             :    REAL,    INTENT (IN)  :: tau(3,nops)
     140             :    INTEGER, INTENT (OUT) :: inv_op(nops)
     141             :    INTEGER, INTENT (OUT) :: multtab(nops,nops)
     142             :    INTEGER, INTENT (OUT) :: optype(nops)
     143             : 
     144             :    REAL    ttau(3)
     145             :    INTEGER i,j,n,k,mp(3,3),mdet,mtr
     146             : 
     147             :    REAL,    PARAMETER :: eps=1.0e-7
     148             :    INTEGER, PARAMETER :: cops(-1:3)=(/ 2, 3, 4, 6, 1 /)
     149             : 
     150         541 :    inv_op(1:nops) = 0
     151             : 
     152         541 :    multtab = 0
     153             : 
     154             :    ! loop over all operations
     155         541 :    DO j = 1, nops
     156             : 
     157             :       ! multiply {R_j|t_j}{R_i|t_i}
     158       18842 :       DO i = 1, nops
     159       18301 :          mp = matmul( mrot(:,:,j) , mrot(:,:,i) )
     160       18301 :          ttau = tau(:,j) + matmul( mrot(:,:,j) , tau(:,i) )
     161       73204 :          ttau = ttau - anint( ttau - eps )
     162             : 
     163             :          ! determine which operation this is
     164     1625615 :          DO k=1,nops
     165      821958 :             IF ( all( mp(:,:) == mrot(:,:,k) ) .and. all( abs( ttau(:)-tau(:,k) ) < eps ) ) THEN
     166       18301 :                IF ( multtab(j,i) .eq. 0 ) THEN
     167       18301 :                   multtab(j,i) = k
     168       18301 :                   IF (k .eq. 1) inv_op(j)=i
     169             :                ELSE
     170           0 :                   WRITE(6,'(" Symmetry error: multiple ops")')
     171           0 :                   CALL juDFT_error("check_close: Multiple ops",calledby ="closure")
     172             :                END IF
     173             :             END IF
     174             :          END DO
     175             : 
     176       18816 :          IF (multtab(j,i).eq.0) THEN
     177           0 :             WRITE (6,'(" Group not closed")')
     178           0 :             WRITE (6,'("  j , i =",2i4)') j,i
     179           0 :             CALL juDFT_error("check_close: Not closed",calledby="closure")
     180             :          END IF
     181             :       END DO
     182             :    END DO
     183             : 
     184             :    ! determine the type of each operation
     185        1056 :    DO n = 1, nops
     186         515 :       mtr = mrot(1,1,n) + mrot(2,2,n) + mrot(3,3,n)
     187             :       mdet = mrot(1,1,n)*(mrot(2,2,n)*mrot(3,3,n)-mrot(3,2,n)*mrot(2,3,n)) +&
     188             :              mrot(1,2,n)*(mrot(3,1,n)*mrot(2,3,n)-mrot(2,1,n)*mrot(3,3,n)) +&
     189         515 :              mrot(1,3,n)*(mrot(2,1,n)*mrot(3,2,n)-mrot(3,1,n)*mrot(2,2,n))
     190             : 
     191         541 :       optype(n) = mdet*cops(mdet*mtr)
     192             : 
     193             :    END DO
     194             : 
     195          26 : END SUBROUTINE check_close
     196             : 
     197             : END MODULE m_closure

Generated by: LCOV version 1.13