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

          Line data    Source code
       1             : MODULE m_qal21 
       2             :   !***********************************************************************
       3             :   ! Calculates qal21  needed to determine the off-diagonal parts of the 
       4             :   ! DOS
       5             :   !***********************************************************************
       6             :   !
       7             : CONTAINS
       8           0 :   SUBROUTINE qal_21(dimension,atoms,input,noccbd,noco,eigVecCoeffs,denCoeffsOffdiag,ikpt,dos)
       9             : 
      10             :     USE m_types_setup
      11             :     USE m_types_dos
      12             :     USE m_types_cdnval, ONLY: t_eigVecCoeffs 
      13             :     USE m_types_denCoeffsOffdiag
      14             :     USE m_rotdenmat
      15             :     use m_constants
      16             :     IMPLICIT NONE
      17             :     TYPE(t_dimension),         INTENT(IN)    :: dimension
      18             :     TYPE(t_input),             INTENT(IN)    :: input
      19             :     TYPE(t_noco),              INTENT(IN)    :: noco
      20             :     TYPE(t_atoms),             INTENT(IN)    :: atoms
      21             :     TYPE(t_eigVecCoeffs),      INTENT(IN)    :: eigVecCoeffs
      22             :     TYPE(t_denCoeffsOffdiag),  INTENT(IN)    :: denCoeffsOffdiag
      23             :     TYPE(t_dos),               INTENT(INOUT) :: dos
      24             : 
      25             :     !     .. Scalar Arguments ..
      26             :     INTEGER, INTENT (IN) :: noccbd,ikpt
      27             : 
      28             :     !     .. Local Scalars ..
      29             :     INTEGER i,l,lo,lop ,natom,nn,ntyp
      30             :     INTEGER nt1,nt2,lm,n,ll1,ipol,icore,index,m
      31             :     REAL fac
      32             :     COMPLEX sumaa,sumbb,sumab,sumba
      33             : 
      34             :     !     .. Local Arrays ..
      35           0 :     COMPLEX qlo(noccbd,atoms%nlod,atoms%nlod,atoms%ntype)
      36           0 :     COMPLEX qaclo(noccbd,atoms%nlod,atoms%ntype),qbclo(noccbd,atoms%nlod,atoms%ntype)
      37           0 :     COMPLEX qcloa(noccbd,atoms%nlod,atoms%ntype),qclob(noccbd,atoms%nlod,atoms%ntype)
      38           0 :     COMPLEX qal21(0:3,atoms%ntype,dimension%neigd)
      39             :     COMPLEX q_loc(2,2),q_hlp(2,2),chi(2,2)
      40           0 :     REAL    qmat(0:3,atoms%ntype,dimension%neigd,4)
      41             : 
      42             :     !     .. Intrinsic Functions ..
      43             :     INTRINSIC conjg
      44           0 :     qal21=0.0
      45             :     !--->    l-decomposed density for each occupied state
      46           0 :     states : DO i = 1, noccbd
      47             :        nt1 = 1
      48           0 :        types_loop : DO n = 1 ,atoms%ntype
      49           0 :           nt2 = nt1 + atoms%neq(n) - 1
      50           0 :           ls : DO l = 0,3
      51             :              IF (i==1) THEN
      52             :              ENDIF
      53           0 :              sumaa = CMPLX(0.,0.) ; sumab = CMPLX(0.,0.) 
      54           0 :              sumbb = CMPLX(0.,0.) ; sumba = CMPLX(0.,0.)
      55           0 :              ll1 = l* (l+1)
      56           0 :              ms : DO m = -l,l
      57           0 :                 lm = ll1 + m
      58           0 :                 atoms_loop : DO natom = nt1,nt2
      59           0 :                    sumaa = sumaa + eigVecCoeffs%acof(i,lm,natom,1)* CONJG(eigVecCoeffs%acof(i,lm,natom,input%jspins))
      60           0 :                    sumbb = sumbb + eigVecCoeffs%bcof(i,lm,natom,1)* CONJG(eigVecCoeffs%bcof(i,lm,natom,input%jspins))
      61           0 :                    sumba = sumba + eigVecCoeffs%acof(i,lm,natom,1) * CONJG(eigVecCoeffs%bcof(i,lm,natom,input%jspins))
      62           0 :                    sumab = sumab + eigVecCoeffs%bcof(i,lm,natom,1) * CONJG(eigVecCoeffs%acof(i,lm,natom,input%jspins))
      63             :                 ENDDO atoms_loop
      64             :              ENDDO ms
      65             :              qal21(l,n,i) = sumaa * denCoeffsOffdiag%uu21n(l,n) + sumbb * denCoeffsOffdiag%dd21n(l,n) +&
      66           0 :                             sumba * denCoeffsOffdiag%du21n(l,n) + sumab * denCoeffsOffdiag%ud21n(l,n) 
      67             :           ENDDO ls
      68           0 :           nt1 = nt1 + atoms%neq(n)
      69             :        ENDDO types_loop
      70             :     ENDDO states
      71             : 
      72             :     !---> initialize qlo
      73             : 
      74           0 :     qlo(:,:,:,:) = CMPLX(0.,0.)
      75           0 :     qaclo(:,:,:) = CMPLX(0.,0.)
      76           0 :     qcloa(:,:,:) = CMPLX(0.,0.)
      77           0 :     qclob(:,:,:) = CMPLX(0.,0.)
      78           0 :     qbclo(:,:,:) = CMPLX(0.,0.)
      79             : 
      80             :     !---> density for each local orbital and occupied state
      81             : 
      82             :     natom = 0
      83           0 :     DO ntyp = 1,atoms%ntype
      84           0 :        DO nn = 1,atoms%neq(ntyp)
      85           0 :           natom = natom + 1
      86           0 :           DO lo = 1,atoms%nlo(ntyp)
      87           0 :              l = atoms%llo(lo,ntyp)
      88           0 :              ll1 = l* (l+1)
      89           0 :              DO m = -l,l
      90           0 :                 lm = ll1 + m
      91           0 :                 DO i = 1, noccbd
      92             :                    qbclo(i,lo,ntyp) = qbclo(i,lo,ntyp) +      &
      93           0 :                         eigVecCoeffs%bcof(i,lm,natom,1)*CONJG(eigVecCoeffs%ccof(m,i,lo,natom,input%jspins)) 
      94             :                    qbclo(i,lo,ntyp) = qbclo(i,lo,ntyp) +      &
      95           0 :                         eigVecCoeffs%ccof(m,i,lo,natom,1)*CONJG(eigVecCoeffs%bcof(i,lm,natom,input%jspins)) 
      96             :                    qaclo(i,lo,ntyp) = qaclo(i,lo,ntyp) +       &
      97           0 :                         eigVecCoeffs%acof(i,lm,natom,1)*CONJG(eigVecCoeffs%ccof(m,i,lo,natom,input%jspins)) 
      98             :                    qaclo(i,lo,ntyp) = qaclo(i,lo,ntyp) +       &
      99           0 :                         eigVecCoeffs%ccof(m,i,lo,natom,1)*CONJG(eigVecCoeffs%acof(i,lm,natom,input%jspins)) 
     100             :                 ENDDO
     101             :              ENDDO
     102           0 :              DO lop = 1,atoms%nlo(ntyp)
     103           0 :                 IF (atoms%llo(lop,ntyp).EQ.l) THEN
     104           0 :                    DO m = -l,l
     105           0 :                       DO i = 1, noccbd
     106             :                          qlo(i,lop,lo,ntyp) = qlo(i,lop,lo,ntyp) +  &
     107             :                               CONJG(eigVecCoeffs%ccof(m,i,lop,natom,input%jspins))*eigVecCoeffs%ccof(m,i,lo,natom,1) +&
     108           0 :                               CONJG(eigVecCoeffs%ccof(m,i,lo,natom,input%jspins))*eigVecCoeffs%ccof(m,i,lop,natom,1)
     109             :                       ENDDO
     110             :                    ENDDO
     111             :                 ENDIF
     112             :              ENDDO
     113             :           ENDDO
     114             :        ENDDO
     115             :     ENDDO
     116             : 
     117             :     !---> perform brillouin zone integration and sum over bands
     118             : 
     119           0 :     DO ntyp = 1,atoms%ntype
     120           0 :        DO lo = 1,atoms%nlo(ntyp)
     121           0 :           l = atoms%llo(lo,ntyp)
     122           0 :           DO i = 1, noccbd
     123             :              qal21(l,ntyp,i)= qal21(l,ntyp,i)  + &
     124             :                   qaclo(i,lo,ntyp)*denCoeffsOffdiag%uulo21n(lo,ntyp) +&
     125             :                   qcloa(i,lo,ntyp)*denCoeffsOffdiag%ulou21n(lo,ntyp) +&
     126             :                   qclob(i,lo,ntyp)*denCoeffsOffdiag%ulod21n(lo,ntyp) +&
     127           0 :                   qbclo(i,lo,ntyp)*denCoeffsOffdiag%dulo21n(lo,ntyp)
     128             :           END DO
     129           0 :           DO lop = 1,atoms%nlo(ntyp)
     130           0 :              IF (atoms%llo(lop,ntyp).EQ.l) THEN
     131           0 :                 DO i = 1, noccbd
     132             :                    qal21(l,ntyp,i)= qal21(l,ntyp,i)  + &
     133           0 :                         qlo(i,lop,lo,ntyp)*denCoeffsOffdiag%uloulop21n(lop,lo,ntyp)
     134             :                 ENDDO
     135             :              ENDIF
     136             :           ENDDO
     137             :        END DO
     138             :     END DO
     139             : 
     140           0 :     DO n = 1,atoms%ntype
     141           0 :        fac = 1./atoms%neq(n)
     142           0 :        qal21(:,n,:) = qal21(:,n,:) * fac
     143             :     ENDDO
     144             :     !
     145             :     ! rotate into global frame
     146             :     !
     147           0 :     TYPE_loop : DO n = 1,atoms%ntype 
     148           0 :        chi(1,1) =  EXP(-ImagUnit*noco%alph(n)/2)*COS(noco%beta(n)/2)
     149           0 :        chi(1,2) = -EXP(-ImagUnit*noco%alph(n)/2)*SIN(noco%beta(n)/2)
     150           0 :        chi(2,1) =  EXP( ImagUnit*noco%alph(n)/2)*SIN(noco%beta(n)/2)
     151           0 :        chi(2,2) =  EXP( ImagUnit*noco%alph(n)/2)*COS(noco%beta(n)/2)
     152           0 :        state : DO i = 1, noccbd
     153           0 :           lls : DO l = 0,3
     154             :              CALL rot_den_mat(noco%alph(n),noco%beta(n),&
     155           0 :                   dos%qal(l,n,i,ikpt,1),dos%qal(l,n,i,ikpt,2),qal21(l,n,i))
     156           0 :              IF (.FALSE.) THEN
     157             :                 IF (n==1) WRITE(*,'(3i3,4f10.5)') l,n,i,qal21(l,n,i),dos%qal(l,n,i,ikpt,:)
     158             :                 q_loc(1,1) = dos%qal(l,n,i,ikpt,1); q_loc(2,2) = dos%qal(l,n,i,ikpt,2)
     159             :                 q_loc(1,2) = qal21(l,n,i); q_loc(2,1) = CONJG(q_loc(1,2))
     160             :                 q_hlp = MATMUL( TRANSPOSE( CONJG(chi) ) ,q_loc)
     161             :                 q_loc = MATMUL(q_hlp,chi)
     162             :                 qmat(l,n,i,1) = REAL(q_loc(1,1))
     163             :                 qmat(l,n,i,2) = REAL(q_loc(1,2))
     164             :                 qmat(l,n,i,3) = AIMAG(q_loc(1,2))
     165             :                 qmat(l,n,i,4) = REAL(q_loc(2,2))
     166             :                 IF (n==1) WRITE(*,'(3i3,4f10.5)') l,n,i,qmat(l,n,i,:)
     167             :              ENDIF
     168             :           ENDDO lls
     169             :        ENDDO state
     170             :     ENDDO TYPE_loop
     171             : 
     172           0 :   END SUBROUTINE qal_21
     173             : END MODULE m_qal21

Generated by: LCOV version 1.13