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

          Line data    Source code
       1             :       MODULE m_localsym
       2             : !*********************************************************************
       3             : !     generate the lattice harmonics appropriate to the local symmetry
       4             : !     of the atoms, given the space group  operations, bravias lattice,
       5             : !     and the atomic positions.
       6             : !
       7             : !     the coordinate system for vector and operations must be given.
       8             : !     here it is assumed that vectors and operations are given in
       9             : !     terms of INTERNAL coordinates, i.e., in terms of a1,a2,a3. this
      10             : !     is the more complicated case; for everything in cartesian
      11             : !     coordinates, the needed changes are rather obvious.
      12             : !
      13             : !     input:
      14             : !        lmax     max. l to calculate for each atom type
      15             : !        lmaxd    max. l (needed to set array sizes)
      16             : !        a1,a2,a3 primitive translation vectors; CARTESIAN coord.
      17             : !
      18             : !        nops     number of operations in space group
      19             : !        mrot     rotation matrices in INTERNAL coordinates:
      20             : !                      ( 1,1 1,2 1,3 )( t_1 )   ( t_1' )
      21             : !                      ( 2,1 2,2 2,3 )( t_2 ) = ( t_2' )
      22             : !                      ( 3,1 3,2 3,3 )( t_3 )   ( t_3' )
      23             : !        tau      non-primitive translations, in INTERNAL coord.
      24             : !
      25             : !        ntype    number of atom types
      26             : !        neq      number of equivalent atoms of each type
      27             : !        ntyrep   representative atom for each type
      28             : !        pos      atomic positions in INTERNAL coord. (in fleur: taual)
      29             : !
      30             : !     the results for the lattice harmonics and local symmetry
      31             : !     information is put into the module mod_harmonics which can then
      32             : !     be use'd as needed.
      33             : !                                              m. weinert 12-99
      34             : !*********************************************************************
      35             :       CONTAINS
      36          76 :       SUBROUTINE local_sym(
      37          76 :      >                     lmaxd,lmax,nops,mrot,tau,
      38          76 :      >                     natd,ntype,neq,amat,bmat,pos,
      39             :      X                     nlhd,memd,ntypsd,l_dim,
      40          76 :      <                     nlhtyp,ntypsy,nlh,llh,nmem,mlh,clnu)
      41             : 
      42             :       USE m_ptsym
      43             :       USE m_lhcal
      44             :       USE m_constants, ONLY : pimach
      45             :       IMPLICIT NONE
      46             : 
      47             : !---> Arguments
      48             :       INTEGER, INTENT (IN) :: lmaxd,nops,ntype,natd
      49             :       INTEGER, INTENT (IN) :: neq(ntype),lmax(ntype),mrot(3,3,nops)
      50             :       REAL,    INTENT (IN) :: tau(3,nops),pos(3,natd)
      51             :       REAL,    INTENT (IN) :: amat(3,3),bmat(3,3)
      52             :       LOGICAL, INTENT (IN) :: l_dim
      53             :       INTEGER              :: nlhd,memd,ntypsd
      54             :       INTEGER              :: nlhtyp(ntype)
      55             :       INTEGER, INTENT(OUT) :: ntypsy(natd)
      56             :       INTEGER, INTENT(OUT) :: llh(0:nlhd,ntypsd),nmem(0:nlhd,ntypsd)
      57             :       INTEGER, INTENT(OUT) ::  mlh(memd,0:nlhd,ntypsd),nlh(ntypsd)
      58             :       COMPLEX, INTENT(OUT) :: clnu(memd,0:nlhd,ntypsd)
      59             : 
      60             : !---> Locals
      61             :       INTEGER :: lmax0,mem_maxd,nlhd_max
      62             :       INTEGER :: lh,lm0,m,n,nsym,na,nsymt,nn
      63         152 :       REAL    :: orth(3,3,nops),amatinv(3,3)
      64         304 :       INTEGER :: nlhs(natd),locops(nops,natd),nrot(natd)
      65         152 :       INTEGER :: lnu((lmaxd+1)**2,natd)
      66         152 :       INTEGER :: mem((lmaxd+1)**2,natd)
      67         152 :       INTEGER :: lmnu(2*lmaxd+1,(lmaxd+1)**2,natd)
      68         152 :       COMPLEX :: c(2*lmaxd+1,(lmaxd+1)**2,natd)
      69             : 
      70          76 :       INTEGER, ALLOCATABLE :: typsym(:)
      71             : 
      72          76 :       amatinv = bmat / ( 2 * pimach() )
      73          76 :       mem_maxd = 2*lmaxd+1
      74          76 :       nlhd_max = (lmaxd+1)**2
      75          76 :       ALLOCATE ( typsym(natd) )
      76             : 
      77          76 :       WRITE (6,'(//," Local symmetries:",/,1x,17("-"))')
      78             : !
      79             : !===> determine the point group symmetries for each atom given
      80             : !===> the space group operations and atomic positions
      81             : !===> operations and positions are in internal (lattice) coordinates
      82             : !
      83             :       CALL ptsym(
      84             :      >           ntype,natd,neq,pos,nops,mrot,tau,lmax,
      85          76 :      <           nsymt,typsym,nrot,locops)
      86             : 
      87          76 :       WRITE (6,'("   symmetry kinds =",i4)') nsymt
      88         184 :       DO nsym = 1, nsymt
      89             :          WRITE (6,'(/,"   symmetry",i3,":",i4," operations in",
      90         108 :      &       " local point group",/,8x,"atoms:")') nsym,nrot(nsym)
      91         108 :          na = 0
      92         488 :          DO n=1,ntype
      93         798 :            DO nn = 1, neq(n)
      94         386 :              na = na + 1 
      95         690 :              IF ( typsym(na) == nsym ) WRITE (6,'(i14)') na
      96             :            ENDDO
      97             :          ENDDO
      98             :       ENDDO
      99             : !
     100             : !===>  generate the lattice harmonics for each local symmetry
     101             : !
     102         184 :       DO nsym = 1, nsymt
     103             : 
     104             : !--->    need to generate transformation matrices in cartesian
     105             : !--->    coordinates (rotations in real space)
     106        1152 :          DO n = 1, nrot(nsym)
     107             :             orth(:,:,n) = matmul( amat,
     108        1152 :      &         matmul( real( mrot(:,:,locops(n,nsym))),amatinv ) )
     109             :          ENDDO
     110             : 
     111             : !--->    get max. l for this symmetry type
     112         108 :          lmax0 = 0
     113         108 :          na = 0
     114         412 :          DO n=1,ntype
     115         798 :            DO nn = 1, neq(n)
     116         386 :              na = na + 1
     117         690 :              IF (typsym(na).EQ.nsym) lmax0 = max(lmax0,lmax(n))
     118             :            ENDDO
     119             :          ENDDO
     120             : 
     121             : !--->     generate the lattice harmonics
     122             :          CALL lhcal(
     123             :      >              mem_maxd,nlhd_max,lmax0,nrot(nsym),orth,
     124             :      <              nlhs(nsym),lnu(1,nsym),mem(1,nsym),
     125         184 :      <              lmnu(1,1,nsym),c(1,1,nsym))
     126             : 
     127             :       ENDDO
     128             : !
     129             : !====>  allocate arrays in module mod_harmonics and store for later use
     130             : !====>  this part can be changed depending on program to interface to;
     131             : !====>  this version is consistent with fleur.
     132             : !
     133          76 :       nlhd = 0
     134          76 :       memd = 0
     135         184 :       DO nsym = 1, nsymt
     136         108 :          nlhd = max(nlhd,nlhs(nsym))
     137        2412 :          DO lh=1,nlhs(nsym)
     138        2336 :             memd = max(memd,mem(lh,nsym))
     139             :          ENDDO
     140             :       ENDDO
     141          76 :       nlhd = nlhd - 1
     142             : 
     143          76 :       IF ( nsymt > ntypsd ) ntypsd = nsymt
     144          76 :       IF ( l_dim ) THEN
     145          38 :          DEALLOCATE ( typsym )
     146          38 :          RETURN
     147             :       ENDIF
     148          92 :       clnu = cmplx( 0.0,0.0 )
     149          92 :       mlh = 0
     150          92 :       DO nsym = 1,nsymt
     151          54 :          nlh(nsym) = nlhs(nsym)-1
     152        1206 :          DO lh = 1, nlhs(nsym)
     153        1114 :             llh(lh-1,nsym)  = lnu(lh,nsym)
     154        1114 :             nmem(lh-1,nsym) = mem(lh,nsym)
     155        1114 :             lm0 = lnu(lh,nsym)*(lnu(lh,nsym)+1) + 1
     156        3243 :             DO m = 1, mem(lh,nsym)
     157        2075 :                mlh(m,lh-1,nsym) = lmnu(m,lh,nsym) - lm0
     158        3189 :                clnu(m,lh-1,nsym) = c(m,lh,nsym)
     159             :             ENDDO
     160             :          ENDDO
     161             :       ENDDO
     162             : 
     163          92 :       WHERE ( abs(aimag(clnu)) < 1.e-13 ) clnu = cmplx( real(clnu),0.0)
     164          92 :       WHERE ( abs( real(clnu)) < 1.e-13 ) clnu = cmplx(0.0,aimag(clnu))
     165             : !
     166             : !--->    different atom types may have the same symmetry, but different
     167             : !--->    lmax. to deal with this possibility, define nlhtyp(ntype) to
     168             : !--->    give the number of harmonics for each atom type.
     169             : !
     170          38 :       na = 0
     171         125 :       DO n = 1, ntype
     172          87 :          nlhtyp(n) = 0
     173         234 :          DO nn = 1,neq(n)
     174         109 :             na = na + 1
     175        2059 :             DO lh = 1, nlh( typsym(na) )
     176        1863 :                IF ( llh(lh,typsym(na)) .GT. lmax(n) ) EXIT
     177         109 :                nlhtyp(n) = nlhtyp(n) + 1
     178             :             ENDDO
     179             :          ENDDO
     180             :       ENDDO
     181             : 
     182          38 :       na = 0
     183         125 :       DO n = 1, ntype
     184         234 :          DO nn = 1,neq(n)
     185         109 :             na = na + 1
     186         196 :             ntypsy(na) = typsym(na)
     187             : !            ntypsy(na) = typsym(na-nn+1)
     188             :          ENDDO
     189             :       ENDDO
     190             : 
     191             : !---> output results
     192          92 :       DO n = 1, nsymt
     193             :         WRITE (6,'(/," --- Local symmetry",i3,":",i4,
     194          54 :      &       " lattice harmonics ",30("-"))') n,nlh(n)+1
     195          92 :         DO lh = 0,nlh(n)
     196             :           WRITE (6,'(/,5x,"lattice harmonic",i4,":  l=",i2,
     197        1114 :      &         ",",i3," members:")') lh+1,llh(lh,n),nmem(lh,n)
     198        1168 :           IF ( mod(nmem(lh,n),2)==1 ) THEN
     199             :             WRITE (6,'(5x,i5,2f14.8,5x,i5,2f14.8)')
     200         409 :      &                     mlh(1,lh,n),clnu(1,lh,n)
     201         409 :             IF ( nmem(lh,n) > 1 ) THEN
     202             :               WRITE (6,'(5x,i5,2f14.8,5x,i5,2f14.8)')
     203          24 :      &             (mlh(m,lh,n),clnu(m,lh,n),m=2,nmem(lh,n))
     204             :             ENDIF
     205             :           ELSE
     206             :             WRITE (6,'(5x,i5,2f14.8,5x,i5,2f14.8)')
     207         705 :      &            (mlh(m,lh,n),clnu(m,lh,n),m=1,nmem(lh,n))
     208             :           ENDIF
     209             :         ENDDO
     210             :       ENDDO
     211             : 
     212          38 :       DEALLOCATE ( typsym )
     213          38 :       RETURN
     214             :       END SUBROUTINE local_sym
     215             :       END MODULE m_localsym

Generated by: LCOV version 1.13