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

          Line data    Source code
       1             :       MODULE m_symproperties
       2             :       use m_juDFT
       3             : !********************************************************************
       4             : !      calculates various properties about each symmetry operation
       5             : !      and the space group + lattice
       6             : !********************************************************************
       7             :       CONTAINS
       8          23 :       SUBROUTINE symproperties(
       9          46 :      >                         nop48,optype,oldfleur,nops,multtab,amat,
      10          46 :      X                         symor,mrot,tau,
      11             :      <                         invsym,invs,zrfs,invs2,nop,nop2)
      12             : 
      13             :       IMPLICIT NONE
      14             : 
      15             : !===> Arguments
      16             :       INTEGER, INTENT (IN)  :: nop48,nops
      17             :       INTEGER, INTENT (IN)  :: optype(nop48),multtab(nops,nops)
      18             :       REAL,    INTENT (IN)  :: amat(3,3)
      19             :       LOGICAL, INTENT (IN)  :: oldfleur
      20             :       LOGICAL, INTENT (OUT) :: invsym,invs,zrfs,invs2
      21             :       INTEGER, INTENT (OUT) :: nop,nop2                ! if .oldfleur. nop <=nops
      22             :       LOGICAL, INTENT (INOUT) :: symor
      23             :       INTEGER, INTENT (INOUT) :: mrot(3,3,nops)
      24             :       REAL,    INTENT (INOUT) :: tau(3,nops)
      25             : 
      26             : !===> Local Variables
      27             : 
      28             :       INTEGER invsop, zrfsop, invs2op, magicinv
      29             :       INTEGER i,j,na,nn,n,dbgfh
      30          75 :       INTEGER indtwo(nop48), usedop(nop48)
      31          46 :       INTEGER mrotaux(3,3,nop48)
      32             :       INTEGER mtab(nops,nops),iop(nops)
      33          46 :       REAL    tauaux(3,nop48), eps12
      34             :       LOGICAL zorth           ! true, if z-axis is othorgonal
      35             : 
      36          23 :       invsym  = .false.
      37          23 :       invs    = .false.
      38          23 :       zrfs    = .false.
      39          23 :       invs2   = .false.
      40          23 :       invsop  = 0
      41          23 :       zrfsop  = 0
      42          23 :       invs2op = 0
      43          23 :       eps12   = 1.0e-12
      44          23 :       dbgfh   = 6
      45             : 
      46             : !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      47             : 
      48          23 :       symor= .true.
      49         204 :       IF ( any ( abs(tau(:,1:nops)) > eps12 ) ) symor = .false.
      50             : 
      51         394 :       DO n = 1, nops
      52             : 
      53         371 :          IF ( optype(n) == -1 )then
      54          15 :             invsym = .true.
      55             : !--->       check if we have inversion as a symmetry operation
      56          15 :             IF ( all ( abs( tau(:,n) ) < eps12 ) ) THEN
      57          15 :                invsop = n
      58          15 :                invs = .true.
      59             :             ENDIF
      60             :          ENDIF
      61             : 
      62         371 :          IF ( optype(n) == -2 )then
      63             : !--->      check for z-reflection
      64          92 :            IF ( mrot(3,3,n) == -1 .and. all(abs(tau(:,n))<eps12) ) THEN
      65           5 :               zrfsop = n
      66           5 :               zrfs = .true.
      67             :            ENDIF
      68             :          ENDIF
      69             : 
      70         394 :          IF ( optype(n) == 2 )then
      71             : !--->      check for 2d inversion
      72          75 :            IF ( mrot(3,3,n) == 1 .and. all(abs(tau(:,n))<eps12) ) THEN
      73           7 :               invs2op = n
      74           7 :               invs2 = .true.
      75             :            ENDIF
      76             :          ENDIF
      77             : 
      78             :       ENDDO !nops
      79             : 
      80             :       IF ( amat(3,1)==0.00 .and. amat(3,2)==0.00 .and.
      81          23 :      &     amat(1,3)==0.00 .and. amat(2,3)==0.00 ) THEN
      82          15 :         zorth= .true.
      83             :       ELSE       
      84           8 :         zorth= .false.
      85             :         ! reset the following...
      86           8 :         zrfs    = .false.
      87           8 :         invs2   = .false.
      88             :       ENDIF
      89             : 
      90          23 :       WRITE(6,*)
      91          23 :       WRITE(6,*) 'DBG: symor,zorth,oldfleur :', symor,zorth,oldfleur
      92          23 :       WRITE(6,'(1x,a13,48i5)') 'DBG: optype :', optype(1:nops)
      93          23 :       WRITE(6,*) 'DBG: invsym,invs,zrfs,invs2 :', invsym,invs,zrfs,invs2
      94             :       WRITE(6,'(1x,a45,3i5)') 
      95          23 :      &           'DBG: (before reorder) invsop,zrfsop,invs2op :', 
      96          46 :      &                                  invsop,zrfsop,invs2op
      97             : 
      98          23 :       IF ( (.not.oldfleur) .or. (.not.zorth) ) THEN
      99          17 :         nop = nops
     100          17 :         nop2 = 0
     101          17 :         IF (.not.oldfleur) RETURN
     102             :       ENDIF
     103           6 :       IF ( oldfleur .and. (.not.zorth) ) THEN
     104             :          CALL juDFT_error("oldfleur = t and z-axis not orthogonal"
     105           0 :      +        ,calledby ="symproperties")
     106             :       ENDIF
     107           6 :       nop = nops
     108             : 
     109             : !---> now we have to sort the ops to find the two-dimensional ops
     110             : !---> and their 3-dim inverted or z-reflected counterparts
     111             : 
     112          58 :       mrotaux(:,:,1:nops) = mrot(:,:,1:nops)
     113          58 :       tauaux(:,1:nops) = tau(:,1:nops)
     114             : 
     115         110 :       DO i=1,nops
     116          58 :          indtwo(i)= i
     117             :       ENDDO
     118             : 
     119           6 :       nop2=0
     120          58 :       DO i = 1, nops
     121          58 :          IF ( mrot(3,3,i) == 1 ) then
     122          26 :             nop2 = nop2 + 1
     123          26 :             indtwo(nop2)= i
     124             :          ENDIF
     125             :       ENDDO
     126             : 
     127             : !dbg  write(dbgfh,*) 'DBG: nop2 : ', nop2
     128             : 
     129           6 :       magicinv = 0
     130           6 :       IF (zrfs) magicinv = zrfsop
     131           6 :       IF (invs) magicinv = invsop
     132         294 :       usedop = 1
     133             : 
     134           6 :       IF ( magicinv > 0 ) THEN
     135          32 :         DO i = 1, nop2
     136          26 :           j = indtwo(i)
     137          26 :           mrot(:,:,i) = mrotaux(:,:,j)
     138          26 :           tau(:,i)    = tauaux(:,j)
     139          26 :           usedop(j) = usedop(j) - 1
     140          26 :           j = multtab(magicinv,indtwo(i))
     141          26 :           mrot(:,:,i+nop2) =  mrotaux(:,:,j)
     142          26 :           tau(:,i+nop2) = tauaux(:,j)
     143          32 :           usedop(j) = usedop(j) - 1
     144             :         ENDDO
     145             : 
     146          58 :         IF ( any( usedop(1:nops) < 0 ) ) THEN
     147           0 :            WRITE (dbgfh,*) 'DBG: usedop : ', usedop(1:nops)
     148           0 :            CALL juDFT_error("Fatal Error! #01",calledby="symproperties")
     149             :         ENDIF
     150             : 
     151           6 :         nop = 2*nop2
     152           6 :         IF ( nop.ne.nops ) THEN
     153           0 :           n = 0
     154           0 :           DO i = 1, nops
     155           0 :             IF ( usedop(i) == 1 ) THEN
     156           0 :               n = n + 1
     157           0 :               mrot(:,:,nop+n) =  mrotaux(:,:,i)
     158           0 :               tau(:,nop+n) = tauaux(:,i)
     159             :             ENDIF
     160             :           ENDDO
     161             : 
     162             : !dbg      write(dbgfh,*) 'DBG: nops, nop, n : ', nops, nop, n
     163             : 
     164           0 :           IF ( n+nop /= nops )  CALL juDFT_error("Fatal Error! #02"
     165           0 :      +         ,calledby ="symproperties")
     166             :         ENDIF
     167             : 
     168             :       ENDIF
     169             : 
     170             : 
     171             : !---> check for nonsymmorphic translations in z-direction in
     172             : !---> the film (oldfleur=t) case
     173             : 
     174           6 :       IF ( oldfleur ) THEN
     175             : 
     176           6 :         n = 1
     177          58 :         DO WHILE (n <= nop)
     178          58 :           IF (abs(tau(3,n)) > 0.000001) THEN
     179           0 :             mrotaux(:,:,1) = mrot(:,:,n)
     180           0 :             tauaux(:,1) = tau(:,n)
     181           0 :             DO nn = n+1, nops
     182           0 :               mrot(:,:,nn-1) = mrot(:,:,nn)
     183           0 :               tau(:,nn-1) = tau(:,nn)
     184             :             ENDDO
     185           0 :             mrot(:,:,nops) = mrotaux(:,:,1)
     186           0 :             tau(:,nops) = tauaux(:,1) 
     187           0 :             nop = nop - 1
     188           0 :             write(*,*) 'op',n,'removed'
     189             :           ELSE
     190          52 :             n = n + 1
     191             :           ENDIF
     192             :         ENDDO
     193           6 :         write(*,*) 'nop =',nop
     194             : 
     195             :       ENDIF
     196             : 
     197           6 :       IF ( oldfleur .AND. nop.NE.nops ) THEN
     198           0 :         WRITE(6,'(/," Full space group has",i3," operations.",/)') nops
     199             :         WRITE(6,'(i3," operations violate the 2d symmetry in fleur21",
     200           0 :      & " and have been removed.",/)') nops-nop
     201           0 :         DO n = nop+1, nops
     202           0 :           WRITE(6,'(" operation",i3,":  ")') n
     203             :           WRITE(6,'(15x,"  (",3i3," )  (",f6.3," )")')
     204           0 :      &         ((mrot(j,i,n),i=1,3),tau(j,n),j=1,3)
     205             :         ENDDO
     206           0 :         WRITE(6,'(/,"Reduced space group has",i3," operations.",/)') nop
     207             : !        nops = nop
     208             :       ELSE
     209           6 :         nop = nops
     210             :       ENDIF
     211             : 
     212             :       END SUBROUTINE symproperties
     213             :       END MODULE m_symproperties

Generated by: LCOV version 1.13