LCOV - code coverage report
Current view: top level - cdn - n_mat.f90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 38 50 76.0 %
Date: 2019-09-08 04:53:50 Functions: 1 1 100.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_nmat
       8             :   !     ************************************************************
       9             :   !     This subroutine calculates the density matrix n^{s}_{m,m'}
      10             :   !     for a given atom 'n' and l-quantum number 'l'. The l's for
      11             :   !     all atoms are stored in lda_u(), if lda_u()<0, no +U is used.
      12             :   !     For details see Eq.(12) of Shick et al. PRB 60, 10765 (1999)
      13             :   !     Part of the LDA+U package                   G.B., Oct. 2000
      14             :   !     Extension to multiple U per atom type by G.M. 2017
      15             :   !     ************************************************************
      16             : CONTAINS
      17          90 :   SUBROUTINE n_mat(atoms,sym, ne,usdus,jspin,we,eigVecCoeffs,n_mmp)
      18             :     !
      19             : 
      20             :     USE m_types
      21             :     USE m_constants
      22             :     IMPLICIT NONE
      23             :     TYPE(t_usdus),INTENT(IN)        :: usdus
      24             :     TYPE(t_sym),INTENT(IN)          :: sym
      25             :     TYPE(t_atoms),INTENT(IN)        :: atoms
      26             :     TYPE(t_eigVecCoeffs),INTENT(IN) :: eigVecCoeffs
      27             :     !     ..
      28             :     !     .. Scalar Arguments ..
      29             :     INTEGER, INTENT (IN) :: ne,jspin 
      30             :     !     ..
      31             :     !     .. Array Arguments ..
      32             :     REAL,    INTENT (IN) :: we(:)!(dimension%neigd)
      33             :     COMPLEX, INTENT (INOUT) :: n_mmp(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,atoms%n_u)
      34             :     !     ..
      35             :     !     .. Local Scalars ..
      36             :     COMPLEX c_0
      37             :     INTEGER i,j,k,l ,mp,n,it,is,isi,natom,natomTemp,n_ldau,lp,m,i_u
      38             :     INTEGER ilo,ilop,ll1,nn,lmp,lm
      39             :     REAL fac
      40             :     !     ..
      41             :     !     .. Local Arrays ..
      42             :     COMPLEX n_tmp(-3:3,-3:3),nr_tmp(-3:3,-3:3),d_tmp(-3:3,-3:3)
      43             :     COMPLEX n1_tmp(-3:3,-3:3)
      44             :     !     ..
      45             :     !
      46             :     ! calculate n_mat:
      47             :     !
      48          90 :     natom = 0
      49          90 :     i_u = 1
      50         270 :     DO n = 1,atoms%ntype
      51         900 :        DO WHILE (i_u.LE.atoms%n_u)
      52         450 :           IF (atoms%lda_u(i_u)%atomType.GT.n) EXIT
      53         360 :           natomTemp = natom
      54         360 :           n_tmp(:,:) = cmplx(0.0,0.0)
      55         360 :           l = atoms%lda_u(i_u)%l
      56         360 :           ll1 = (l+1)*l 
      57         720 :           DO nn = 1, atoms%neq(n)
      58         360 :              natomTemp = natomTemp + 1
      59             :              !
      60             :              !  prepare n_mat in local frame (in noco-calculations this depends 
      61             :              !                                also on alpha(n) and beta(n) )
      62             :              !
      63        1800 :              DO m = -l,l
      64        1440 :                 lm = ll1+m
      65        7920 :                 DO mp = -l,l
      66        6120 :                    lmp = ll1+mp
      67        6120 :                    c_0 = cmplx(0.0,0.0)
      68       91800 :                    DO i = 1,ne
      69             :                       c_0 = c_0 +  we(i) * ( usdus%ddn(l,n,jspin) *&
      70             :                            conjg(eigVecCoeffs%bcof(i,lmp,natomTemp,jspin))*eigVecCoeffs%bcof(i,lm,natomTemp,jspin) +&
      71       91800 :                            conjg(eigVecCoeffs%acof(i,lmp,natomTemp,jspin))*eigVecCoeffs%acof(i,lm,natomTemp,jspin) )
      72             :                    ENDDO
      73        7560 :                    n_tmp(m,mp) = c_0 
      74             :                 ENDDO
      75             :              ENDDO
      76             :              !
      77             :              !  add local orbrbital contribution (if there is one) (untested so far)
      78             :              !
      79         360 :              DO ilo = 1, atoms%nlo(n)
      80         360 :                 IF (atoms%llo(ilo,n).EQ.l) THEN
      81             : 
      82           0 :                    DO m = -l,l
      83           0 :                       lm = ll1+m
      84           0 :                       DO mp = -l,l
      85           0 :                          lmp = ll1+mp
      86           0 :                          c_0 = cmplx(0.0,0.0)
      87           0 :                          DO i = 1,ne
      88             :                             c_0 = c_0 +  we(i) * (  usdus%uulon(ilo,n,jspin) * (&
      89             :                                  conjg(eigVecCoeffs%acof(i,lmp,natomTemp,jspin))*eigVecCoeffs%ccof(m,i,ilo,natomTemp,jspin) +&
      90             :                                  conjg(eigVecCoeffs%ccof(mp,i,ilo,natomTemp,jspin))*eigVecCoeffs%acof(i,lm,natomTemp,jspin) )&
      91             :                                  + usdus%dulon(ilo,n,jspin) * (&
      92             :                                  conjg(eigVecCoeffs%bcof(i,lmp,natomTemp,jspin))*eigVecCoeffs%ccof(m,i,ilo,natomTemp,jspin) +&
      93           0 :                                  conjg(eigVecCoeffs%ccof(mp,i,ilo,natomTemp,jspin))*eigVecCoeffs%bcof(i,lm,natomTemp,jspin)))
      94             :                          ENDDO
      95           0 :                          DO ilop = 1, atoms%nlo(n)
      96           0 :                             IF (atoms%llo(ilop,n).EQ.l) THEN
      97           0 :                                DO i = 1,ne
      98             :                                   c_0 = c_0 +  we(i) * usdus%uloulopn(ilo,ilop,n,jspin) *&
      99           0 :                                        conjg(eigVecCoeffs%ccof(mp,i,ilop,natomTemp,jspin)) *eigVecCoeffs%ccof(m,i,ilo,natomTemp,jspin)
     100             :                                ENDDO
     101             :                             ENDIF
     102             :                          ENDDO
     103           0 :                          n_tmp(m,mp) = n_tmp(m,mp) + c_0
     104             :                       ENDDO
     105             :                    ENDDO
     106             : 
     107             :                 ENDIF
     108             :              ENDDO
     109             :              !
     110             :              !  n_mmp should be rotated by D_mm' ; compare force_a21
     111             :              !
     112        2880 :              DO it = 1, sym%invarind(natomTemp)
     113             : 
     114        2160 :                 fac = 1.0  /  ( sym%invarind(natomTemp) * atoms%neq(n) )
     115        2160 :                 is = sym%invarop(natomTemp,it)
     116        2160 :                 isi = sym%invtab(is)
     117        2160 :                 d_tmp(:,:) = cmplx(0.0,0.0)
     118       10800 :                 DO m = -l,l
     119       84240 :                    DO mp = -l,l
     120       45360 :                       d_tmp(m,mp) = sym%d_wgn(m,mp,l,isi)
     121             :                    ENDDO
     122             :                 ENDDO
     123        2160 :                 nr_tmp = matmul( transpose( conjg(d_tmp) ) , n_tmp)
     124        2160 :                 n1_tmp =  matmul( nr_tmp, d_tmp )
     125       19800 :                 DO m = -l,l
     126       84240 :                    DO mp = -l,l
     127       45360 :                       n_mmp(m,mp,i_u) = n_mmp(m,mp,i_u) + conjg(n1_tmp(m,mp)) * fac
     128             :                    ENDDO
     129             :                 ENDDO
     130             : 
     131             :              ENDDO
     132             : 
     133             :           ENDDO ! sum  over equivalent atoms
     134         540 :           i_u = i_u + 1
     135             :        END DO
     136         270 :        natom = natom + atoms%neq(n)
     137             :     ENDDO     ! loop over atom types
     138             : 
     139             :     !     do m=-l,l
     140             :     !      write(*,'(14f12.6)') (n_mmp(m,mp),mp=-l,l)
     141             :     !     enddo
     142             :     !
     143          90 :     RETURN
     144             :   END SUBROUTINE n_mat
     145             : END MODULE m_nmat

Generated by: LCOV version 1.13