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         400 :    SUBROUTINE ptsym(ntype,natd,neq,pos,nops,mrot,tau,lmax,nsymt,typsym,nrot,locops)
      23             : 
      24             :       USE m_constants
      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) :: nsymt
      33             :       INTEGER, INTENT(OUT) :: typsym(natd), nrot(natd), locops(nops,natd)
      34             : 
      35             :       REAL, PARAMETER :: eps=1.e-7
      36             : 
      37             :       INTEGER :: iop, irot, n, na, nn, nsym
      38         400 :       INTEGER :: indsym(natd), indsym1(natd)
      39             :       REAL    :: v(3), sv(3)
      40             : 
      41             :       ! loop over representative atoms
      42         400 :       na = 1
      43        1085 :       DO n = 1,ntype
      44        2740 :           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        9735 :           DO irot = 1,nops
      50      253400 :             sv = matmul( real(mrot(:,:,irot)) , v ) + tau(:,irot) - v
      51             : !--->       check whether sv is a lattice vector ( sv integer)
      52       33310 :             IF ( ANY( ABS( sv - ANINT(sv) ) > eps ) ) CYCLE
      53             : 
      54             : !--->       this operation belongs to the point group
      55        7890 :             iop = iop + 1
      56        8575 :             locops(iop,na) = irot
      57             :           END DO
      58             : 
      59         685 :           nrot(na) = iop
      60        1085 :           na = na + neq(n)
      61             :       END DO
      62             : 
      63             : !--->    check that the number of operations in local groups are correct
      64         400 :       na = 1
      65        1085 :       DO n = 1, ntype
      66         685 :           IF ( neq(n)*nrot(na) .NE. nops ) THEN
      67           0 :         WRITE (oUnit,'(/a,i3)') ' symmetry is incorrect for atom',na
      68           0 :         WRITE (oUnit,'(" neq=",i3,", nrot=",i3,", nops=",i3)') neq(n),nrot(na),nops
      69           0 :             CALL juDFT_error("symmetry is incorrect for some atomp",calledby ="ptsym")
      70             :           END IF
      71        1085 :           na = na + neq(n)
      72             :       END DO
      73             : 
      74             : !--->    now determine unique symmetry kinds
      75             : 
      76         400 :       nsymt     = 1
      77         400 :       typsym(1) = 1
      78         400 :       indsym(1) = 1
      79         400 :       indsym1(1)= 1
      80             : 
      81         400 :       na = 1
      82        1085 :       atom_loop: DO n = 1, ntype
      83         685 :         IF (na > 1) THEN
      84             : 
      85         405 :           symm_loop: DO nsym = 1, nsymt
      86         340 :             IF ( nrot(na) .NE. nrot(indsym(nsym)) ) CYCLE
      87             : 
      88        2730 :             DO irot=1,nrot(na)
      89        2730 :                IF(locops(irot,na).NE.locops(irot,indsym(nsym))) THEN
      90             :                   CYCLE symm_loop  ! try next symmetry type
      91             :                END IF
      92             :             END DO
      93         260 :             IF ( lmax(n).NE.lmax(indsym1(nsym)) ) CYCLE
      94             : 
      95             : !--->    same symmetry as a previous one:
      96         220 :             typsym(na) = nsym
      97         220 :             na = na + 1
      98         325 :             equi : DO nn = 2, neq(n)
      99         105 :                typsym(na) = nsym
     100         325 :                na = na + 1
     101             :             END DO equi
     102         185 :             CYCLE atom_loop   ! go to next atom
     103             : 
     104             :           END DO symm_loop
     105             : 
     106             : !--->       new symmetry kind
     107          65 :           nsymt = nsymt + 1
     108          65 :           typsym(na) = nsymt
     109          65 :           indsym(nsymt) = na
     110          65 :           indsym1(nsymt) = n
     111             : 
     112             :         END IF
     113         465 :         na = na + 1
     114         980 :         equi_loop : DO nn = 2, neq(n)
     115         115 :            typsym(na) = nsymt
     116         580 :            na = na + 1
     117             :         END DO equi_loop
     118             : 
     119             :       END DO atom_loop
     120             : 
     121             : !--->    pack locops array
     122         465 :       DO n = 2, nsymt
     123          65 :          nrot(n) = nrot(indsym(n))
     124         905 :          DO irot = 1,nrot(n)
     125         505 :             locops(irot,n) = locops(irot,indsym(n))
     126             :          END DO
     127             :       END DO
     128             : 
     129         400 :       RETURN
     130             :    END SUBROUTINE ptsym
     131             : END MODULE m_ptsym