qal_21.f90 7.01 KB
Newer Older
1 2 3 4 5 6 7
MODULE m_qal21 
  !***********************************************************************
  ! Calculates qal21  needed to determine the off-diagonal parts of the 
  ! DOS
  !***********************************************************************
  !
CONTAINS
8
  SUBROUTINE qal_21(dimension,atoms,input,noccbd,noco,eigVecCoeffs,denCoeffsOffdiag,ikpt,dos)
9

10 11 12 13
    USE m_types_setup
    USE m_types_dos
    USE m_types_cdnval, ONLY: t_eigVecCoeffs 
    USE m_types_denCoeffsOffdiag
14
    USE m_rotdenmat
15
    use m_constants
16
    IMPLICIT NONE
17
    TYPE(t_dimension),         INTENT(IN)    :: dimension
18 19 20 21
    TYPE(t_input),             INTENT(IN)    :: input
    TYPE(t_noco),              INTENT(IN)    :: noco
    TYPE(t_atoms),             INTENT(IN)    :: atoms
    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 29 30 31 32 33 34
    !     .. Local Scalars ..
    INTEGER i,l,lo,lop ,natom,nn,ntyp
    INTEGER nt1,nt2,lm,n,ll1,ipol,icore,index,m
    REAL fac
    COMPLEX sumaa,sumbb,sumab,sumba

    !     .. Local Arrays ..
35 36 37
    COMPLEX qlo(noccbd,atoms%nlod,atoms%nlod,atoms%ntype)
    COMPLEX qaclo(noccbd,atoms%nlod,atoms%ntype),qbclo(noccbd,atoms%nlod,atoms%ntype)
    COMPLEX qcloa(noccbd,atoms%nlod,atoms%ntype),qclob(noccbd,atoms%nlod,atoms%ntype)
38
    COMPLEX qal21(0:3,atoms%ntype,dimension%neigd)
39
    COMPLEX q_loc(2,2),q_hlp(2,2),chi(2,2)
40 41
    REAL    qmat(0:3,atoms%ntype,dimension%neigd,4)

42 43
    !     .. Intrinsic Functions ..
    INTRINSIC conjg
Daniel Wortmann's avatar
Daniel Wortmann committed
44
    qal21=0.0
45 46 47 48 49 50 51 52 53 54 55 56 57 58
    !--->    l-decomposed density for each occupied state
    states : DO i = 1, noccbd
       nt1 = 1
       types_loop : DO n = 1 ,atoms%ntype
          nt2 = nt1 + atoms%neq(n) - 1
          ls : DO l = 0,3
             IF (i==1) THEN
             ENDIF
             sumaa = CMPLX(0.,0.) ; sumab = CMPLX(0.,0.) 
             sumbb = CMPLX(0.,0.) ; sumba = CMPLX(0.,0.)
             ll1 = l* (l+1)
             ms : DO m = -l,l
                lm = ll1 + m
                atoms_loop : DO natom = nt1,nt2
59 60 61 62
                   sumaa = sumaa + eigVecCoeffs%acof(i,lm,natom,1)* CONJG(eigVecCoeffs%acof(i,lm,natom,input%jspins))
                   sumbb = sumbb + eigVecCoeffs%bcof(i,lm,natom,1)* CONJG(eigVecCoeffs%bcof(i,lm,natom,input%jspins))
                   sumba = sumba + eigVecCoeffs%acof(i,lm,natom,1) * CONJG(eigVecCoeffs%bcof(i,lm,natom,input%jspins))
                   sumab = sumab + eigVecCoeffs%bcof(i,lm,natom,1) * CONJG(eigVecCoeffs%acof(i,lm,natom,input%jspins))
63 64
                ENDDO atoms_loop
             ENDDO ms
65 66
             qal21(l,n,i) = sumaa * denCoeffsOffdiag%uu21n(l,n) + sumbb * denCoeffsOffdiag%dd21n(l,n) +&
                            sumba * denCoeffsOffdiag%du21n(l,n) + sumab * denCoeffsOffdiag%ud21n(l,n) 
67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92
          ENDDO ls
          nt1 = nt1 + atoms%neq(n)
       ENDDO types_loop
    ENDDO states

    !---> initialize qlo

    qlo(:,:,:,:) = CMPLX(0.,0.)
    qaclo(:,:,:) = CMPLX(0.,0.)
    qcloa(:,:,:) = CMPLX(0.,0.)
    qclob(:,:,:) = CMPLX(0.,0.)
    qbclo(:,:,:) = CMPLX(0.,0.)

    !---> density for each local orbital and occupied state

    natom = 0
    DO ntyp = 1,atoms%ntype
       DO nn = 1,atoms%neq(ntyp)
          natom = natom + 1
          DO lo = 1,atoms%nlo(ntyp)
             l = atoms%llo(lo,ntyp)
             ll1 = l* (l+1)
             DO m = -l,l
                lm = ll1 + m
                DO i = 1, noccbd
                   qbclo(i,lo,ntyp) = qbclo(i,lo,ntyp) +      &
93
                        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
                        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
                        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
                        eigVecCoeffs%ccof(m,i,lo,natom,1)*CONJG(eigVecCoeffs%acof(i,lm,natom,input%jspins)) 
100 101 102 103 104 105 106
                ENDDO
             ENDDO
             DO lop = 1,atoms%nlo(ntyp)
                IF (atoms%llo(lop,ntyp).EQ.l) THEN
                   DO m = -l,l
                      DO i = 1, noccbd
                         qlo(i,lop,lo,ntyp) = qlo(i,lop,lo,ntyp) +  &
107 108
                              CONJG(eigVecCoeffs%ccof(m,i,lop,natom,input%jspins))*eigVecCoeffs%ccof(m,i,lo,natom,1) +&
                              CONJG(eigVecCoeffs%ccof(m,i,lo,natom,input%jspins))*eigVecCoeffs%ccof(m,i,lop,natom,1)
109 110 111 112 113 114 115 116 117 118 119 120 121 122 123
                      ENDDO
                   ENDDO
                ENDIF
             ENDDO
          ENDDO
       ENDDO
    ENDDO

    !---> perform brillouin zone integration and sum over bands

    DO ntyp = 1,atoms%ntype
       DO lo = 1,atoms%nlo(ntyp)
          l = atoms%llo(lo,ntyp)
          DO i = 1, noccbd
             qal21(l,ntyp,i)= qal21(l,ntyp,i)  + &
124 125 126 127
                  qaclo(i,lo,ntyp)*denCoeffsOffdiag%uulo21n(lo,ntyp) +&
                  qcloa(i,lo,ntyp)*denCoeffsOffdiag%ulou21n(lo,ntyp) +&
                  qclob(i,lo,ntyp)*denCoeffsOffdiag%ulod21n(lo,ntyp) +&
                  qbclo(i,lo,ntyp)*denCoeffsOffdiag%dulo21n(lo,ntyp)
128 129 130 131 132
          END DO
          DO lop = 1,atoms%nlo(ntyp)
             IF (atoms%llo(lop,ntyp).EQ.l) THEN
                DO i = 1, noccbd
                   qal21(l,ntyp,i)= qal21(l,ntyp,i)  + &
133
                        qlo(i,lop,lo,ntyp)*denCoeffsOffdiag%uloulop21n(lop,lo,ntyp)
134 135 136 137 138 139 140 141 142 143 144 145 146 147
                ENDDO
             ENDIF
          ENDDO
       END DO
    END DO

    DO n = 1,atoms%ntype
       fac = 1./atoms%neq(n)
       qal21(:,n,:) = qal21(:,n,:) * fac
    ENDDO
    !
    ! rotate into global frame
    !
    TYPE_loop : DO n = 1,atoms%ntype 
148 149 150 151
       chi(1,1) =  EXP(-ImagUnit*noco%alph(n)/2)*COS(noco%beta(n)/2)
       chi(1,2) = -EXP(-ImagUnit*noco%alph(n)/2)*SIN(noco%beta(n)/2)
       chi(2,1) =  EXP( ImagUnit*noco%alph(n)/2)*SIN(noco%beta(n)/2)
       chi(2,2) =  EXP( ImagUnit*noco%alph(n)/2)*COS(noco%beta(n)/2)
152 153 154
       state : DO i = 1, noccbd
          lls : DO l = 0,3
             CALL rot_den_mat(noco%alph(n),noco%beta(n),&
155
                  dos%qal(l,n,i,ikpt,1),dos%qal(l,n,i,ikpt,2),qal21(l,n,i))
156
             IF (.FALSE.) THEN
157 158
                IF (n==1) WRITE(*,'(3i3,4f10.5)') l,n,i,qal21(l,n,i),dos%qal(l,n,i,ikpt,:)
                q_loc(1,1) = dos%qal(l,n,i,ikpt,1); q_loc(2,2) = dos%qal(l,n,i,ikpt,2)
159 160 161 162 163 164 165 166 167 168 169 170 171 172 173
                q_loc(1,2) = qal21(l,n,i); q_loc(2,1) = CONJG(q_loc(1,2))
                q_hlp = MATMUL( TRANSPOSE( CONJG(chi) ) ,q_loc)
                q_loc = MATMUL(q_hlp,chi)
                qmat(l,n,i,1) = REAL(q_loc(1,1))
                qmat(l,n,i,2) = REAL(q_loc(1,2))
                qmat(l,n,i,3) = AIMAG(q_loc(1,2))
                qmat(l,n,i,4) = REAL(q_loc(2,2))
                IF (n==1) WRITE(*,'(3i3,4f10.5)') l,n,i,qmat(l,n,i,:)
             ENDIF
          ENDDO lls
       ENDDO state
    ENDDO TYPE_loop

  END SUBROUTINE qal_21
END MODULE m_qal21