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

          Line data    Source code
       1             :       MODULE m_ptsym
       2             :       use m_juDFT
       3             : !********************************************************************
       4             : !     determines the point group symmetry for each representative
       5             : !     atom and then check whether there are several with the same
       6             : !     local symmetry.
       7             : !
       8             : !     input:  nops      number of operations in space group
       9             : !             mrot      rotation matrices in INTERNAL coordinates
      10             : !             tau       non-primitive translations, in INTERNAL coord.
      11             : !
      12             : !             ntype     number of atom types
      13             : !             neq       number of equivalent atoms of each type
      14             : !             pos       atomic positions in INTERNAL coord.
      15             : !
      16             : !     output: nsymt     number of symmetry kinds
      17             : !             typsym    symmetry kind for each atom type
      18             : !             nrot      number of operations for each symmetry kind
      19             : !             locops    mapping of operations to space group list
      20             : !*********************************************************************
      21             :       CONTAINS
      22          76 :       SUBROUTINE ptsym(
      23         228 :      >                 ntype,natd,neq,pos,nops,mrot,tau,lmax,
      24         152 :      <                 nsymt,typsym,nrot,locops)
      25             : 
      26             :       IMPLICIT NONE
      27             : 
      28             :       INTEGER, INTENT (IN) :: ntype,neq(ntype),natd
      29             :       INTEGER, INTENT (IN) :: nops,mrot(3,3,nops),lmax(ntype)
      30             :       REAL,    INTENT (IN) :: tau(3,nops),pos(3,natd)
      31             : 
      32             :       INTEGER, INTENT(OUT) :: locops(nops,natd),nrot(natd)
      33             :       INTEGER, INTENT(OUT) :: nsymt,typsym(natd)
      34             : 
      35             :       REAL, PARAMETER :: eps=1.e-7
      36             : 
      37             :       INTEGER :: iop,irot,n,na,nn,nsym
      38         152 :       INTEGER :: indsym(natd),indsym1(natd)
      39             :       REAL    :: v(3),sv(3)
      40             : 
      41             : !--->    loop over representative atoms
      42          76 :       na = 1
      43         250 :       DO n = 1,ntype
      44         174 :           v(:) = pos(:,na)
      45             : 
      46             : !--->     loop over space group operations to see which belong
      47             : !--->     to point group: sv = {R|t_R}v - v = Rv + t_R - v
      48             :           iop = 0
      49        4350 :           DO irot = 1,nops
      50        2088 :             sv = matmul( real(mrot(:,:,irot)) , v ) + tau(:,irot) - v
      51             : !--->       check whether sv is a lattice vector ( sv integer)
      52        7688 :             IF ( ANY( ABS( sv - ANINT(sv) ) > eps ) ) CYCLE
      53             : 
      54             : !--->       this operation belongs to the point group
      55        1792 :             iop = iop + 1
      56        2262 :             locops(iop,na) = irot
      57             :           ENDDO
      58             : 
      59         174 :           nrot(na) = iop
      60         250 :           na = na + neq(n)
      61             :       ENDDO
      62             : 
      63             : !--->    check that the number of operations in local groups are correct
      64          76 :       na = 1
      65         250 :       DO n = 1, ntype
      66         174 :           IF ( neq(n)*nrot(na) .NE. nops ) THEN
      67           0 :             WRITE (6,'(/a,i3)') ' symmetry is incorrect for atom',na
      68             :             WRITE (6,'(" neq=",i3,", nrot=",i3,", nops=",i3)')            
      69           0 :      &               neq(n),nrot(na),nops
      70             :             CALL juDFT_error("symmetry is incorrect for some atomp"
      71           0 :      +           ,calledby ="ptsym")
      72             :           ENDIF
      73         250 :           na = na + neq(n)
      74             :       ENDDO
      75             : 
      76             : !--->    now determine unique symmetry kinds
      77             : 
      78          76 :       nsymt     = 1
      79          76 :       typsym(1) = 1
      80          76 :       indsym(1) = 1
      81          76 :       indsym1(1)= 1
      82             : 
      83          76 :       na = 1
      84         250 :       atom_loop: DO n = 1, ntype
      85         174 :         IF (na > 1) THEN 
      86             : 
      87         166 :           symm_loop: DO nsym = 1, nsymt
      88         134 :             IF ( nrot(na) .NE. nrot(indsym(nsym)) ) CYCLE
      89             : 
      90        2072 :             DO irot=1,nrot(na)
      91        1084 :                IF(locops(irot,na).NE.locops(irot,indsym(nsym))) THEN
      92             :                   CYCLE symm_loop  ! try next symmetry type
      93             :                ENDIF
      94             :             ENDDO
      95          96 :             IF ( lmax(n).NE.lmax(indsym1(nsym)) ) CYCLE
      96             : 
      97             : !--->    same symmetry as a previous one:
      98          66 :             typsym(na) = nsym
      99          66 :             na = na + 1
     100          88 :             equi : DO nn = 2, neq(n)
     101          22 :                typsym(na) = nsym
     102          88 :                na = na + 1
     103             :             ENDDO equi
     104         100 :             CYCLE atom_loop   ! go to next atom
     105             : 
     106             :           ENDDO symm_loop
     107             : 
     108             : !--->       new symmetry kind
     109          32 :           nsymt = nsymt + 1
     110          32 :           typsym(na) = nsymt
     111          32 :           indsym(nsymt) = na
     112          32 :           indsym1(nsymt) = n
     113             : 
     114             :         ENDIF
     115         108 :         na = na + 1
     116         206 :         equi_loop : DO nn = 2, neq(n) 
     117          22 :            typsym(na) = nsymt
     118         130 :            na = na + 1
     119             :         ENDDO equi_loop
     120             : 
     121             :       ENDDO atom_loop
     122             : 
     123             : !--->    pack locops array
     124         108 :       DO n = 2, nsymt
     125          32 :          nrot(n) = nrot(indsym(n))
     126         324 :          DO irot = 1,nrot(n)
     127         248 :             locops(irot,n) = locops(irot,indsym(n))
     128             :          ENDDO
     129             :       ENDDO
     130             : 
     131          76 :       RETURN
     132             :       END SUBROUTINE ptsym
     133             :       END MODULE m_ptsym

Generated by: LCOV version 1.13