force_a21_lo.f90 6.89 KB
Newer Older
1 2 3 4 5 6
!--------------------------------------------------------------------------------
! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------

7 8
MODULE m_forcea21lo
CONTAINS
9 10
  SUBROUTINE force_a21_lo(atoms,isp,itype,we,eig,ne,eigVecCoeffs,&
                          aveccof,bveccof,cveccof,tlmplm,usdus,a21)
11 12 13 14 15 16 17 18
    !
    !***********************************************************************
    ! This subroutine calculates the local orbital contribution to A21,
    ! which is the combination of the terms A17 and A20 according to the
    ! paper of R.Yu et al. (PRB vol.43 no.8 p.64111991).
    ! p.kurz nov. 1997
    !***********************************************************************
    !
19 20 21 22
    USE m_types_setup
    USE m_types_usdus
    USE m_types_tlmplm
    USE m_types_cdnval
23
    IMPLICIT NONE
24 25 26 27
    TYPE(t_usdus),INTENT(IN)        :: usdus
    TYPE(t_tlmplm),INTENT(IN)       :: tlmplm
    TYPE(t_atoms),INTENT(IN)        :: atoms
    TYPE(t_eigVecCoeffs),INTENT(IN) :: eigVecCoeffs
28 29
    !     ..
    !     .. Scalar Arguments ..
30
    INTEGER, INTENT (IN) :: itype,ne,isp
31 32
    !     ..
    !     .. Array Arguments ..
33 34 35 36 37
    REAL,    INTENT(IN)    :: we(ne),eig(:)!(dimension%neigd)
    REAL,    INTENT(INOUT) :: a21(3,atoms%nat)
    COMPLEX, INTENT(IN)    :: aveccof(3,ne,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat)
    COMPLEX, INTENT(IN)    :: bveccof(3,ne,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat)
    COMPLEX, INTENT(IN)    :: cveccof(3,-atoms%llod:atoms%llod,ne,atoms%nlod,atoms%nat)
38 39 40
    !     ..
    !     .. Local Scalars ..
    COMPLEX utulo,dtulo,cutulo,cdtulo,ulotulo
41
    INTEGER lo,lop,l,lp ,mp,lm,lmp,iatom,ie,i,lolop,loplo,in,m,lo1
42 43 44 45 46 47 48 49 50 51 52 53
    !     ..
    !     ..
    !*************** ABBREVIATIONS *****************************************
    ! ccof       : coefficient of the local orbital function (u_lo*Y_lm)
    ! cveccof    : is defined equivalently to aveccof, but with the LO-fct.
    ! tuulo,tdulo and tuloulo are the MT hamiltonian matrix elements of the
    ! local orbitals with the flapw basisfct. and with themselves.
    ! for information on nlo,llo,nlol,lo1l,uulon,dulon, and uloulopn see
    ! comments in setlomap.
    !***********************************************************************

    DO lo = 1,atoms%nlo(itype)
54
       lo1=SUM(atoms%nlo(:itype-1))+lo
55 56 57 58 59 60
       l = atoms%llo(lo,itype)
       DO m = -l,l
          lm = l* (l+1) + m
          DO lp = 0,atoms%lmax(itype)
             DO mp = -lp,lp
                lmp = lp* (lp+1) + mp
61
                DO iatom = sum(atoms%neq(:itype-1))+1,sum(atoms%neq(:itype))
62 63 64 65
                   !
                   !--->             check whether the t-matrixelement is 0
                   !--->             (indmat.EQ.-9999)
                   !
66
                   in = tlmplm%ind(lmp,lm,itype,1)
67
                   IF ((in.NE.-9999).OR.(lmp.EQ.lm)) THEN
68 69 70 71
                      utulo = tlmplm%tuulo(lmp,m,lo1,1)
                      dtulo = tlmplm%tdulo(lmp,m,lo1,1)
                      cutulo = conjg(tlmplm%tuulo(lmp,m,lo1,1))
                      cdtulo = conjg(tlmplm%tdulo(lmp,m,lo1,1))
72 73 74
                      DO ie = 1,ne
                         DO i = 1,3
                            a21(i,iatom)=a21(i,iatom)+2.0*aimag(&
75
                                 conjg(eigVecCoeffs%acof(ie,lmp,iatom,isp))*utulo&
76
                                 *cveccof(i,m,ie,lo,iatom)&
77
                                 + conjg(eigVecCoeffs%bcof(ie,lmp,iatom,isp))*dtulo&
78
                                 *cveccof(i,m,ie,lo,iatom)&
79
                                 + conjg(eigVecCoeffs%ccof(m,ie,lo,iatom,isp))&
80
                                 *cutulo*aveccof(i,ie,lmp,iatom)&
81
                                 + conjg(eigVecCoeffs%ccof(m,ie,lo,iatom,isp))&
82
                                 *cdtulo*bveccof(i,ie,lmp,iatom)&
83 84 85 86 87 88 89 90 91 92 93 94
                                 )*we(ie)/atoms%neq(itype)
                         ENDDO
                      ENDDO
                   ENDIF
                ENDDO

             ENDDO
          ENDDO
          DO lop = 1,atoms%nlo(itype)
             lp = atoms%llo(lop,itype)
             DO mp = -lp,lp
                lmp = lp* (lp+1) + mp
95
                DO iatom = sum(atoms%neq(:itype-1))+1,sum(atoms%neq(:itype))
96
                   in = tlmplm%ind(lmp,lm,itype,1)
97
                   IF ((in.NE.-9999).OR.(lmp.EQ.lm)) THEN
98
                      lolop=DOT_PRODUCT(atoms%nlo(:itype-1),atoms%nlo(:itype-1)+1)/2
99
                      IF (lo.GE.lop) THEN
100
                         lolop = (lo-1)*lo/2 + lop + lolop
101
                         ulotulo = tlmplm%tuloulo(m,mp,lolop,1)
102
                      ELSE
103
                         loplo = (lop-1)*lop/2 + lo +lolop
104
                         ulotulo = conjg(tlmplm%tuloulo(mp,m,loplo,1))
105 106 107 108
                      ENDIF
                      DO ie = 1,ne
                         DO i = 1,3
                            a21(i,iatom)=a21(i,iatom)+2.0*aimag(&
109
                                 + conjg(eigVecCoeffs%ccof(m,ie,lo,iatom,isp))&
110
                                 *ulotulo*cveccof(i,mp,ie,lop,iatom)&
111 112 113 114 115 116 117
                                 )*we(ie)/atoms%neq(itype)
                         ENDDO
                      ENDDO
                   ENDIF
                ENDDO
             ENDDO
          ENDDO
118
          DO iatom = sum(atoms%neq(:itype-1))+1,sum(atoms%neq(:itype))
119 120 121 122
             DO ie = 1,ne
                DO i = 1,3
                   a21(i,iatom)=a21(i,iatom)&
                        -2.0*aimag(&
123 124 125 126
                        (conjg(eigVecCoeffs%acof(ie,lm,iatom,isp))*cveccof(i,m,ie,lo,iatom)+&
                        conjg(eigVecCoeffs%ccof(m,ie,lo,iatom,isp))*aveccof(i,ie,lm,iatom))*usdus%uulon(lo,itype,isp)+&
                        (conjg(eigVecCoeffs%bcof(ie,lm,iatom,isp))*cveccof(i,m,ie,lo,iatom)+&
                        conjg(eigVecCoeffs%ccof(m,ie,lo,iatom,isp))*bveccof(i,ie,lm,iatom))*&
127 128 129 130 131 132
                        usdus%dulon(lo,itype,isp))*eig(ie)*we(ie)/atoms%neq(itype)
                ENDDO
             ENDDO
          ENDDO
          !--->       consider only the lop with l_lop = l_lo
          DO lop = atoms%lo1l(l,itype),(atoms%lo1l(l,itype)+atoms%nlol(l,itype)-1)
133
             DO iatom = sum(atoms%neq(:itype-1))+1,sum(atoms%neq(:itype))
134 135 136
                DO ie = 1,ne
                   DO i = 1,3
                      a21(i,iatom)=a21(i,iatom)-2.0*aimag(&
137
                           conjg(eigVecCoeffs%ccof(m,ie,lo,iatom,isp))*&
138
                           cveccof(i,m,ie,lop,iatom)*&
139 140 141 142 143 144 145 146 147 148 149 150 151 152
                           usdus%uloulopn(lo,lop,itype,isp))*&
                           eig(ie)*we(ie)/atoms%neq(itype)

                   ENDDO
                ENDDO
             ENDDO
          ENDDO
          !--->    end of m loop
       ENDDO
       !---> end of lo loop
    ENDDO

  END SUBROUTINE force_a21_lo
END MODULE m_forcea21lo