LCOV - code coverage report
Current view: top level - init - od_mapatom.F90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 0 61 0.0 %
Date: 2019-09-08 04:53:50 Functions: 0 1 0.0 %

          Line data    Source code
       1             : !--------------------------------------------------------------------------------
       2             : ! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
       3             : ! This file is part of FLEUR and available as free software under the conditions
       4             : ! of the MIT license as expressed in the LICENSE file in more detail.
       5             : !--------------------------------------------------------------------------------
       6             : 
       7             :       MODULE m_od_mapatom
       8             :       use m_juDFT
       9             :       CONTAINS 
      10           0 :       SUBROUTINE od_mapatom(oneD,atoms,sym,cell)
      11             : 
      12             : !      written by Y.Mokrousov in order to generate the arrays connected
      13             : !      to the operations, transforming atoms into each other,
      14             : !      for more details look in mapatom.F.    year 2004 
      15             : 
      16             :       USE m_types
      17             :       IMPLICIT NONE
      18             :       TYPE(t_oneD),INTENT(IN)    :: oneD
      19             :       TYPE(t_atoms),INTENT(INOUT):: atoms
      20             :       TYPE(t_sym),INTENT(INOUT)  :: sym
      21             :       TYPE(t_cell),INTENT(IN)    :: cell
      22             : 
      23             : 
      24             :       REAL ij,pps(3),norm,aamat(3,3) 
      25             :       INTEGER i,j,n1,k,n,n2,np1,na,ix,iy,iz,nat1,nat2,na2
      26             :       REAL mt(3,3),sum_tau_lat(3),sum_taual(3)
      27             :       REAL, PARAMETER :: del = 1.0e-4
      28             : 
      29           0 :       aamat=matmul(transpose(cell%amat),cell%amat)
      30             :      
      31           0 :       n1 = 1
      32           0 :       DO n = 1,atoms%ntype
      33           0 :         n2 = n1 + atoms%neq(n) - 1
      34           0 :         IF (atoms%neq(n).EQ.1) THEN
      35           0 :            atoms%ngopr(n2) = 1
      36           0 :            WRITE (6,FMT=8010) n2,n2,atoms%ngopr(n2)
      37           0 :            n1 = n1 + atoms%neq(n)
      38           0 :            CYCLE
      39             :         END IF
      40           0 :         DO  na = n1,n2
      41           0 :            DO np1 = 1,oneD%odd%nop
      42           0 :                   pps =matmul(sym%mrot(:,:,np1),atoms%taual(:,n1))
      43           0 :                   pps(3) = pps(3)+sym%tau(3,np1)/cell%amat(3,3)
      44           0 :                   IF (all(abs(atoms%taual(:,na)-pps(:)).LE.1.e-4 )) THEN
      45           0 :                       atoms%ngopr(na) = np1
      46           0 :                       WRITE (6,FMT=8010) na,n1,atoms%ngopr(na)
      47             :  8010                 FORMAT (5x,'atom',i3,' can be mapped into atom', i3,' through group  operation',i4)
      48           0 :                       CYCLE
      49             :                    END IF
      50             :            END DO
      51             :       ENDDO
      52           0 :         n1 = n1 + atoms%neq(n)
      53             :     ENDDO
      54             : 
      55             : !---> defining inverse operations for the Hamiltonian and forces
      56             : !     where we do not need to consider the translational part
      57             : 
      58           0 :       DO n1 = 1,oneD%odd%nop
      59           0 :          n2loop:DO n2 = 1,oneD%odd%nop
      60           0 :             mt=matmul(sym%mrot(:,:,n1),sym%mrot(:,:,n2))
      61           0 :             DO n = 1,oneD%odd%nop
      62           0 :                if (all(abs(mt(:,:) - sym%mrot(:,:,n)).LE.1.e-06)) THEN
      63           0 :                      sym%multab(n1,n2) = n
      64           0 :                      IF (n.EQ.1) sym%invtab(n1) = n2
      65             :                      cycle n2loop
      66             :                endif
      67             :             enddo
      68           0 :             WRITE (6,FMT=8050) n1,n2
      69             :  8050       FORMAT (' error - n1,n2=',2i3)
      70           0 :             CALL juDFT_error("mult",calledby ="od_mapatom")
      71             :         ENDDO n2loop
      72             :     ENDDO
      73             : 
      74             :  8060 FORMAT (1x,24i3)
      75             : 
      76           0 :       WRITE (6,FMT='(//," inverse operations",//)')
      77             : 
      78           0 :       DO n1 = 1,oneD%odd%nop
      79           0 :          WRITE (6,FMT=8060) n1,sym%invtab(n1)
      80             :       END DO
      81             : 
      82           0 :       DO na = 1,atoms%nat
      83           0 :          atoms%invsat(na) = 0
      84           0 :          sym%invsatnr(na) = 0
      85             :       END DO
      86             : 
      87           0 :       IF (oneD%odd%invs) THEN
      88           0 :          WRITE (6,FMT=*)
      89           0 :          nat1 = 1
      90           0 :          DO n = 1,atoms%ntype
      91           0 :             nat2 = nat1 + atoms%neq(n) - 1
      92           0 :             DO na = nat1,nat2 - 1
      93           0 :                IF (atoms%invsat(na).EQ.0) THEN
      94           0 :                   naloop:DO na2 = na + 1,nat2
      95           0 :                      DO i = 1,3
      96           0 :                         sum_taual(i) = atoms%taual(i,na) + atoms%taual(i,na2)
      97             :                      END DO
      98           0 :                      DO ix = -2,2
      99           0 :                        sum_tau_lat(1) = sum_taual(1) + real(ix)
     100           0 :                        DO iy = -2,2
     101           0 :                          sum_tau_lat(2) = sum_taual(2) + real(iy)
     102           0 :                          DO iz = -2,2
     103           0 :                            sum_tau_lat(3) = sum_taual(3) + real(iz)
     104           0 :                            norm = sqrt(dot_product(matmul(sum_tau_lat,aamat),sum_tau_lat))
     105           0 :                            IF (norm.LT.del) THEN
     106           0 :                               atoms%invsat(na) = 1
     107           0 :                               atoms%invsat(na2) = 2
     108           0 :                               sym%invsatnr(na)  = na2
     109           0 :                               sym%invsatnr(na2) = na
     110           0 :                               WRITE (6,FMT=9000) n,na,na2
     111           0 :                               CYCLE naloop
     112             :                            END IF
     113             :                         END DO
     114             :                       END DO
     115             :                     END DO
     116             :                   ENDDO naloop
     117             :                END IF
     118             :             END DO
     119           0 :             nat1 = nat1 + atoms%neq(n)
     120             :          END DO
     121             :       END IF
     122           0 :       WRITE (6,FMT=*) atoms%invsat
     123             :  9000 FORMAT ('atom type',i3,': atom',i3,' can be mapped into atom',i3, ' via 3d inversion')
     124             : 
     125           0 :       END SUBROUTINE od_mapatom
     126             :       END MODULE m_od_mapatom

Generated by: LCOV version 1.13