LCOV - code coverage report
Current view: top level - init - mapatom.F90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 107 115 93.0 %
Date: 2019-09-08 04:53:50 Functions: 1 1 100.0 %

          Line data    Source code
       1             :       MODULE m_mapatom
       2             :       use m_juDFT
       3             : !*******************************************************************
       4             : !     determines the group operation which maps the representive
       5             : !     atom into its equivalent atoms     c.l.fu
       6             : !*******************************************************************
       7             :       CONTAINS
       8          38 :       SUBROUTINE mapatom(sym,atoms,cell,input,noco)
       9             : !
      10             : !     if (l_f) setup multab,invtab,invarop,invarind for force_a12 & 21
      11             : !***********************************************************************
      12             : ! the contribution to the hamiltonian and to the overlap matrix in a
      13             : ! system with inversion symmetry from one muffin tin is the complex
      14             : ! conjugate of the contribution from the "invers" muffin tin. this fact
      15             : ! can be exploited to save cpu-time in hssphn. Thus, it is nessessary to
      16             : ! know whether an atom can be mapped onto an equivalent atom via 3d
      17             : ! inversion. where both atoms have to belong to the same unit cell, i.e.
      18             : ! the are not related to each other by a lattice translation. therefore,
      19             : ! an array invsatom is set up.
      20             : ! invsatom(natom) =
      21             : ! 0 if the atom cannot be mapped onto an eqivalent atom via inversion
      22             : ! 1 if the atom can be mapped onto an eqivalent atom via inversion, and
      23             : !   has a smaller atom index than the related atom
      24             : ! 2 if the atom can be mapped onto an eqivalent atom via inversion, and
      25             : !   has a bigger atom index than the related atom
      26             : ! p.kurz aug. 1996
      27             : !***********************************************************************
      28             : !
      29             :       USE m_socsym
      30             :       USE m_types
      31             :       IMPLICIT NONE
      32             :       TYPE(t_sym),INTENT(INOUT)   :: sym
      33             :       TYPE(t_atoms),INTENT(INOUT) :: atoms
      34             :       TYPE(t_cell),INTENT(IN)  :: cell
      35             :       TYPE(t_input),INTENT(IN) :: input
      36             :       TYPE(t_noco),INTENT(IN)  :: noco
      37             : 
      38             : !     .. Local Scalars ..
      39             :       REAL s3,norm
      40             :       INTEGER i,icount,j,j1,j2,j3,jop,n,na,nat1,nat2,nb,na_r
      41             :       INTEGER k,ij,n1,n2,ix,iy,iz,na2
      42             :       REAL, PARAMETER :: del = 1.0e-4
      43             : !     ..
      44             : !     .. Local Arrays ..
      45             :       INTEGER mt(3,3),mp(3,3)
      46             :       REAL aamat(3,3),sum_tau_lat(3),sum_taual(3)
      47             :       REAL gam(3),gaminv(3),gamr(3),sr(3),ttau(3)
      48          76 :       LOGICAL error(sym%nop)
      49             : !     ..
      50             : !     .. Intrinsic Functions ..
      51             :       INTRINSIC real,sqrt
      52             : !     ..
      53             :       
      54             :     !  CALL dotset(&
      55             :     ! &            cell,&
      56             :     ! &            aamat, )
      57          38 :       aamat=matmul(transpose(cell%amat),cell%amat)
      58             :     
      59          38 :       IF (noco%l_soc) THEN  ! check once more here...
      60             :         CALL soc_sym(&
      61             :      &               sym%nop,sym%mrot,noco%theta,noco%phi,cell%amat,&
      62           9 :      &               error)
      63             :       ELSE
      64         420 :         error(:) = .false.
      65             :       ENDIF
      66             :                                
      67          38 :       WRITE (6,FMT=8000)
      68             :  8000 FORMAT (/,/,5x,'group operations on equivalent atoms:')
      69          38 :       nat1 = 1
      70         125 :       DO n = 1,atoms%ntype
      71          87 :          nat2 = nat1 + atoms%neq(n) - 1
      72          87 :          atoms%ngopr(nat1) = 1
      73             : !+gu
      74          87 :          na_r = nat1
      75         196 :          DO na = nat1,nat2
      76         109 :             IF (atoms%ntypsy(na).NE.atoms%ntypsy(na_r)) na_r = na
      77             : !-gu
      78         436 :             DO i = 1,3
      79         436 :                gam(i) = atoms%taual(i,na)
      80             :             END DO
      81         109 :             sym%invarind(na) = 0
      82         109 :             icount = 0
      83        1449 :             DO  jop = 1,sym%nop
      84        5360 :                DO i = 1,3
      85        4020 :                   gamr(i) = 0.
      86       16080 :                   DO j = 1,3
      87       16080 :                      gamr(i) = gamr(i) + sym%mrot(i,j,jop)*gam(j)
      88             :                   END DO
      89        5360 :                   gamr(i) = gamr(i) + sym%tau(i,jop)
      90             :                END DO
      91        5360 :                DO i = 1,3
      92        4020 :                   gaminv(i) = gamr(i) - atoms%taual(i,na)
      93        5360 :                   gamr(i)   = gamr(i) - atoms%taual(i,nat1) ! cf local_sym
      94             :                END DO
      95        1340 :                IF (icount.EQ.0) THEN
      96        2618 :                   DO j3 = -2,2
      97        1190 :                      sr(3) = gamr(3) + real(j3)
      98        7378 :                      DO j2 = -2,2
      99        5950 :                         sr(2) = gamr(2) + real(j2)
     100       36890 :                         DO j1 = -2,2
     101       29750 :                            sr(1) = gamr(1) + real(j1)
     102       29750 :                            s3 = sqrt(dot_product(matmul(sr,aamat),sr))
     103       35700 :                            IF ((s3.LT.del).AND.(.not.error(jop))) THEN
     104         109 :                               icount = icount + 1
     105         109 :                               atoms%ngopr(na) = jop
     106             :                            END IF
     107             :                         END DO
     108             :                      END DO
     109             :                   END DO
     110             :                END IF
     111             : !
     112             : ! search for operations which leave taual invariant
     113             : !
     114        1449 :                IF (input%l_f.OR.(atoms%n_u.GT.0)) THEN 
     115         396 :                   DO j3 = -2,2
     116         180 :                      sr(3) = gaminv(3) + real(j3)
     117        1116 :                      DO j2 = -2,2
     118         900 :                         sr(2) = gaminv(2) + real(j2)
     119        5580 :                         DO j1 = -2,2
     120        4500 :                            sr(1) = gaminv(1) + real(j1)
     121        4500 :                            s3 = sqrt(dot_product(matmul(sr,aamat),sr))
     122        5400 :                            IF (s3.LT.del) THEN
     123          36 :                               sym%invarind(na) = sym%invarind(na) + 1
     124          36 :                               sym%invarop(na,sym%invarind(na)) = jop
     125             :                            END IF
     126             :                         END DO
     127             :                      END DO
     128             :                   END DO
     129             :                ENDIF
     130             : !
     131             : ! end of operations
     132             :           ENDDO
     133         109 :             IF (icount.LE.0) THEN
     134           0 :              write(6,*) "Mapping failed for atom:",nat1
     135           0 :              write(6,*) "No of symmetries tested:",sym%nop
     136           0 :              CALL juDFT_error("mapatom",calledby="mapatom")
     137             :            ENDIF
     138         196 :             WRITE (6,FMT=8010) nat1,na,atoms%ngopr(na)
     139             :  8010       FORMAT (5x,'atom',i5,' can be mapped into atom',i5,&
     140             :      &             ' through group  operation',i4)
     141             : !
     142             : ! end of equivalent atoms
     143             :        ENDDO
     144             : !
     145         125 :          nat1 = nat1 + atoms%neq(n)
     146             : !
     147             : ! end of different types of atoms
     148             :     ENDDO
     149             : 
     150             : !------------------------- FORCE PART -------------------------------
     151             : !+gu this is the remainder of spgset necessary for force calculations
     152             : !
     153          38 :       IF (input%l_f.OR.(atoms%n_u.GT.0)) THEN
     154             : 
     155             :       WRITE (6,FMT=&
     156           3 :      &  '(//,"list of operations which leave taual invariant",/)')
     157           9 :       DO na = 1,nat2
     158           6 :          WRITE (6,FMT='("atom nr.",i3,3x,(t14,"ops are:",24i3))') na,&
     159          15 :      &     (sym%invarop(na,nb),nb=1,sym%invarind(na))
     160             :       END DO
     161             : 
     162             :       ENDIF
     163             : !------------------------- FORCE PART ENDS --------------------------
     164             : !
     165             : !     check closure  ; note that:  {R|t} tau = R^{-1} tau -  R^{-1} t
     166             : !
     167             : !--->    loop over all operations
     168             : !
     169          38 :       WRITE (6,FMT=8040)
     170             :  8040 FORMAT (/,/,' multiplication table',/,/)
     171          38 :       sym%multab = 0
     172         500 :       DO j=1,sym%nop
     173             : 
     174             : !--->    multiply {R_j|t_j}{R_i|t_i}
     175        8502 :          DO i=1,sym%nop
     176        8002 :             mp = matmul( sym%mrot(:,:,j) , sym%mrot(:,:,i) )
     177        8002 :             ttau = sym%tau(:,j) + matmul( sym%mrot(:,:,j) , sym%tau(:,i) )
     178       32008 :             ttau = ttau - anint( ttau - 1.e-7 )
     179             : 
     180             : !--->    determine which operation this is
     181      202900 :             DO k=1,sym%nop
     182      194898 :               IF( all( mp(:,:) == sym%mrot(:,:,k) ) .AND.&
     183        8002 :      &            ALL( abs( ttau(:)-sym%tau(:,k) ) < 1.e-7 ) ) THEN
     184        8002 :                  IF (sym%multab(j,i) .EQ. 0 ) THEN
     185        8002 :                     sym%multab(j,i) = k
     186        8002 :                     IF (k .EQ. 1) sym%invtab(j)=i
     187             :                  ELSE
     188           0 :                     WRITE(6,'(" Symmetry error: multiple ops")')
     189           0 :                      CALL juDFT_error("Multiple ops",calledby="mapatom")
     190             :                  ENDIF
     191             :               ENDIF
     192             :             ENDDO
     193             : 
     194        8464 :             IF (sym%multab(j,i).EQ.0) THEN
     195           0 :                WRITE (6,'(" Group not closed")')
     196           0 :                WRITE (6,'("  j , i =",2i4)') j,i
     197             :                CALL juDFT_error("mapatom: group not closed",calledby&
     198           0 :      &              ="mapatom")
     199             :             ENDIF
     200             :          ENDDO
     201             :       ENDDO
     202             : 
     203         500 :       DO n1 = 1,sym%nop
     204         500 :          WRITE (6,FMT=8060) (sym%multab(n1,n2),n2=1,sym%nop)
     205             :       END DO
     206             :  8060 FORMAT (1x,48i3)
     207          38 :       WRITE (6,FMT='(//," inverse operations",//)')
     208         500 :       DO n1 = 1,sym%nop
     209         500 :          WRITE (6,FMT=8060) n1,sym%invtab(n1)
     210             :       END DO
     211             : 
     212         147 :       DO na = 1,atoms%nat
     213         109 :          atoms%invsat(na) = 0
     214         147 :          sym%invsatnr(na) = 0
     215             :       END DO
     216             : 
     217          38 :       IF (.not.(noco%l_soc.and.atoms%n_u>0)) THEN
     218          38 :       IF (sym%invs) THEN
     219          26 :          WRITE (6,FMT=*)
     220          26 :          nat1 = 1
     221          81 :          DO n = 1,atoms%ntype
     222          55 :             nat2 = nat1 + atoms%neq(n) - 1
     223          72 :             DO na = nat1,nat2 - 1
     224          72 :                IF (atoms%invsat(na).EQ.0.AND..NOT.noco%l_noco) THEN
     225          34 :                   naloop:DO na2 = na + 1,nat2
     226          68 :                      DO i = 1,3
     227          68 :                         sum_taual(i) = atoms%taual(i,na) + atoms%taual(i,na2)
     228             :                      END DO
     229          98 :                      DO ix = -2,2
     230          49 :                        sum_tau_lat(1) = sum_taual(1) + real(ix)
     231         241 :                        DO iy = -2,2
     232         209 :                          sum_tau_lat(2) = sum_taual(2) + real(iy)
     233        1235 :                          DO iz = -2,2
     234        1011 :                            sum_tau_lat(3) = sum_taual(3) + real(iz)
     235        1011 :                            norm = sqrt(dot_product(matmul(sum_tau_lat,aamat),sum_tau_lat))
     236        1203 :                            IF (norm.LT.del) THEN
     237          17 :                               atoms%invsat(na) = 1
     238          17 :                               atoms%invsat(na2) = 2
     239          17 :                               sym%invsatnr(na)  = na2
     240          17 :                               sym%invsatnr(na2) = na
     241          17 :                               WRITE (6,FMT=9000) n,na,na2
     242          17 :                               cycle naloop
     243             :                            END IF
     244             :                         END DO
     245             :                       END DO
     246             :                     END DO
     247             :                END DO naloop
     248             :                END IF
     249             :             END DO
     250          81 :             nat1 = nat1 + atoms%neq(n)
     251             :          END DO
     252          26 :       WRITE (6,FMT=*) atoms%invsat
     253             :  9000 FORMAT ('atom type',i3,': atom',i3,' can be mapped into atom',i3,&
     254             :      &       ' via 3d inversion')
     255             :       END IF
     256             :       END IF
     257             :  
     258          38 :       END  SUBROUTINE mapatom
     259             :       END  MODULE m_mapatom

Generated by: LCOV version 1.13