hlomat.F90 15.9 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 9 10 11 12 13
MODULE m_hlomat
!***********************************************************************
! updates the hamiltonian  matrix with the contributions from the local
! orbitals.
! p.kurz sept. 1996
!***********************************************************************
CONTAINS
Daniel Wortmann's avatar
Daniel Wortmann committed
14 15
  SUBROUTINE hlomat(input,atoms,mpi,lapw,ud,tlmplm,sym,cell,noco,isp,&
       ntyp,na,fj,gj,alo1,blo1,clo1, iintsp,jintsp,chi,hmat)
16
    !
Daniel Wortmann's avatar
Daniel Wortmann committed
17
    USE m_hsmt_ab
18 19
    USE m_types
    IMPLICIT NONE
20
    TYPE(t_input),INTENT(IN)  :: input
21 22
    TYPE(t_atoms),INTENT(IN)  :: atoms
    TYPE(t_lapw),INTENT(IN)   :: lapw
Daniel Wortmann's avatar
Daniel Wortmann committed
23 24 25 26 27 28 29 30
    TYPE(t_mpi),INTENT(IN)    :: mpi
    TYPE(t_usdus),INTENT(IN)  :: ud
    TYPE(t_tlmplm),INTENT(IN) :: tlmplm
    TYPE(t_sym),INTENT(IN)    :: sym
    TYPE(t_cell),INTENT(IN)   :: cell
    TYPE(t_noco),INTENT(IN)   :: noco
    
    
31 32 33
    !     ..
    !     .. Scalar Arguments ..
    INTEGER, INTENT (IN) :: na,ntyp  
Daniel Wortmann's avatar
Daniel Wortmann committed
34
    INTEGER, INTENT (IN) :: isp !spin for usdus and tlmplm
35
    INTEGER, INTENT (IN) :: iintsp,jintsp
Daniel Wortmann's avatar
Daniel Wortmann committed
36
    COMPLEX, INTENT (IN) :: chi
37 38
    !     ..
    !     .. Array Arguments ..
Daniel Wortmann's avatar
Daniel Wortmann committed
39 40
    REAL, INTENT (IN) :: alo1(:),blo1(:),clo1(:)
    REAL,INTENT(IN)      :: fj(:,0:,:),gj(:,0:,:)
41

Daniel Wortmann's avatar
Daniel Wortmann committed
42
    CLASS(t_mat),INTENT (INOUT) :: hmat
43 44
    !     ..
    !     .. Local Scalars ..
Daniel Wortmann's avatar
Daniel Wortmann committed
45 46 47 48
    COMPLEX axx,bxx,cxx,dtd,dtu,dtulo,ulotd,ulotu,ulotulo,utd,utu, utulo
    INTEGER im,in,invsfct,l,lm,lmp,lo,lolo,lolop,lop,lp,i  
    INTEGER mp,nkvec,nkvecp,lmplm,loplo,kp,m,mlo,mlolo
    INTEGER locol,lorow,ii,ij,n,k,ab_size
49 50
    !     ..
    !     .. Local Arrays ..
Daniel Wortmann's avatar
Daniel Wortmann committed
51 52
    COMPLEX, ALLOCATABLE :: ab(:,:),ax(:),bx(:),cx(:)
    COMPLEX,ALLOCATABLE  :: abclo(:,:,:,:,:)
53
    !     ..
54

Daniel Wortmann's avatar
Daniel Wortmann committed
55 56 57 58 59 60 61 62
    
    !-->              synthesize the complex conjugates of a and b
    ALLOCATE(ab(MAXVAL(lapw%nv),0:2*atoms%lmaxd*(atoms%lmaxd+2)+1))
    ALLOCATE(ax(MAXVAL(lapw%nv)),bx(MAXVAL(lapw%nv)),cx(MAXVAL(lapw%nv)))
    ALLOCATE(abclo(3,-atoms%llod:atoms%llod,2*(2*atoms%llod+1),atoms%nlod,2))
    DO i=MIN(iintsp,jintsp),MAX(iintsp,jintsp)
       CALL hsmt_ab(sym,atoms,noco,isp,iintsp,ntyp,na,cell,lapw,fj,gj,ab(:,:),ab_size,.TRUE.,abclo(:,:,:,:,i),alo1,blo1,clo1)
    ENDDO
63

Daniel Wortmann's avatar
Daniel Wortmann committed
64
    
65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82
    mlo=0;mlolo=0
    DO m=1,ntyp-1
       mlo=mlo+atoms%nlo(m)
       mlolo=mlolo+atoms%nlo(m)*(atoms%nlo(m)+1)/2
    ENDDO


    !$OMP MASTER
    IF ((atoms%invsat(na).EQ.0) .OR. (atoms%invsat(na).EQ.1)) THEN
       !--->    if this atom is the first of two atoms related by inversion,
       !--->    the contributions to the overlap matrix of both atoms are added
       !--->    at once. where it is made use of the fact, that the sum of
       !--->    these contributions is twice the real part of the contribution
       !--->    of each atom. note, that in this case there are twice as many
       !--->    (2*(2*l+1)) k-vectors (compare abccoflo and comments there).
       IF (atoms%invsat(na).EQ.0) invsfct = 1
       IF (atoms%invsat(na).EQ.1) invsfct = 2
       !
Daniel Wortmann's avatar
Daniel Wortmann committed
83
    
84 85 86 87 88 89 90
       DO lo = 1,atoms%nlo(ntyp)
          l = atoms%llo(lo,ntyp)
          !--->       calculate the hamiltonian matrix elements with the regular
          !--->       flapw basis-functions
          DO m = -l,l
             lm = l* (l+1) + m
             DO kp = 1,lapw%nv(jintsp)
91 92 93
                ax(kp) = CMPLX(0.0,0.0)
                bx(kp) = CMPLX(0.0,0.0)
                cx(kp) = CMPLX(0.0,0.0)
94
             END DO
95
             DO lp = 0,atoms%lnonsph(ntyp)
96 97
                DO mp = -lp,lp
                   lmp = lp* (lp+1) + mp
Daniel Wortmann's avatar
Daniel Wortmann committed
98
                   in = tlmplm%ind(lmp,lm,ntyp,isp)
99 100
                   IF (in.NE.-9999) THEN
                      IF (in.GE.0) THEN
Daniel Wortmann's avatar
Daniel Wortmann committed
101 102 103 104
                         utu = tlmplm%tuu(in,ntyp,isp)
                         dtu = tlmplm%tdu(in,ntyp,isp)
                         utd = tlmplm%tud(in,ntyp,isp)
                         dtd = tlmplm%tdd(in,ntyp,isp)
105 106
                      ELSE
                         im = -in
Daniel Wortmann's avatar
Daniel Wortmann committed
107 108 109 110
                         utu = CONJG(tlmplm%tuu(im,ntyp,isp))
                         dtu = CONJG(tlmplm%tud(im,ntyp,isp))
                         utd = CONJG(tlmplm%tdu(im,ntyp,isp))
                         dtd = CONJG(tlmplm%tdd(im,ntyp,isp))
111
                      END IF
Daniel Wortmann's avatar
Daniel Wortmann committed
112 113
                      utulo = tlmplm%tuulo(lmp,m,lo+mlo,isp)
                      dtulo = tlmplm%tdulo(lmp,m,lo+mlo,isp)
114 115 116 117 118
                      !--->                   note, that utu,dtu... are the t-matrices and
                      !--->                   not their complex conjugates as in hssphn
                      !--->                   and that a,b,alo... are the complex
                      !--->                   conjugates of the a,b...-coefficients
                      DO kp = 1,lapw%nv(jintsp)
Daniel Wortmann's avatar
Daniel Wortmann committed
119 120 121
                         ax(kp) = ax(kp) + ab(kp,lmp)*utu + ab(kp,ab_size/2+lmp)*dtu
                         bx(kp) = bx(kp) + ab(kp,lmp)*utd + ab(kp,ab_size/2+lmp)*dtd
                         cx(kp) = cx(kp) + ab(kp,lmp)*utulo + ab(kp,ab_size/2+lmp)*dtulo
122 123 124 125 126 127
                      END DO
                   END IF
                END DO
             END DO
             !+t3e
             DO nkvec = 1,invsfct* (2*l+1)
128
               locol= lapw%nv(iintsp)+lapw%index_lo(lo,na)+nkvec !this is the column of the matrix
Daniel Wortmann's avatar
Daniel Wortmann committed
129 130
                IF (MOD(locol-1,mpi%n_size).EQ.mpi%n_rank) THEN
                   locol=(locol-1)/mpi%n_size+1 !this is the column in local storage
131
                   !-t3e
Daniel Wortmann's avatar
Daniel Wortmann committed
132
                   IF (hmat%l_real) THEN
133
                      DO kp = 1,lapw%nv(jintsp)
Daniel Wortmann's avatar
Daniel Wortmann committed
134 135 136 137 138 139 140
                         hmat%data_r(kp,locol) = hmat%data_r(kp,locol) + chi*invsfct * (&
                              REAL(abclo(1,m,nkvec,lo,iintsp))* REAL(ax(kp)) +&
                              AIMAG(abclo(1,m,nkvec,lo,iintsp))*AIMAG(ax(kp)) +&
                              REAL(abclo(2,m,nkvec,lo,iintsp))* REAL(bx(kp)) +&
                              AIMAG(abclo(2,m,nkvec,lo,iintsp))*AIMAG(bx(kp)) +&
                              REAL(abclo(3,m,nkvec,lo,iintsp))* REAL(cx(kp)) +&
                              AIMAG(abclo(3,m,nkvec,lo,iintsp))*AIMAG(cx(kp)) )
141 142
                         IF (input%l_useapw) THEN
                            !---> APWlo
Daniel Wortmann's avatar
Daniel Wortmann committed
143 144 145 146 147 148
                            hmat%data_r(kp,locol) = hmat%data_r(kp,locol) + 0.25 * atoms%rmt(ntyp)**2 * chi*invsfct * (&
                                 (CONJG(ab(kp,lm))* ud%us(l,ntyp,isp)+&
                                 CONJG(ab(kp,ab_size/2+lm))*ud%uds(l,ntyp,isp))*&
                                 (abclo(1,m,nkvec,lo,iintsp)*  ud%dus(l,ntyp,isp)&
                                 +abclo(2,m,nkvec,lo,iintsp)* ud%duds(l,ntyp,isp)&
                                 +abclo(3,m,nkvec,lo,iintsp)*ud%dulos(lo,ntyp,isp) ))
149
                         ENDIF
150 151 152
                      ENDDO
                   ELSE
                      DO kp = 1,lapw%nv(jintsp)
Daniel Wortmann's avatar
Daniel Wortmann committed
153 154 155 156
                            hmat%data_c(kp,locol) = hmat%data_c(kp,locol) + chi*invsfct * (&
                                 abclo(1,m,nkvec,lo,iintsp) * CONJG( ax(kp) ) +&
                                 abclo(2,m,nkvec,lo,iintsp) * CONJG( bx(kp) ) +&
                                 abclo(3,m,nkvec,lo,iintsp) * CONJG( cx(kp) ) )
157 158
                            IF (input%l_useapw) THEN
                               !---> APWlo
Daniel Wortmann's avatar
Daniel Wortmann committed
159 160 161 162 163 164
                               hmat%data_c(kp,locol)=hmat%data_c(kp,locol) + 0.25 * atoms%rmt(ntyp)**2 * chi*invsfct*(&
                                    (CONJG(ab(kp,lm))* ud%us(l,ntyp,isp)+&
                                    CONJG(ab(kp,ab_size/2+lm))*ud%uds(l,ntyp,isp))*&
                                    (abclo(1,m,nkvec,lo,iintsp)*  ud%dus(l,ntyp,isp)&
                                    +abclo(2,m,nkvec,lo,iintsp)* ud%duds(l,ntyp,isp)&
                                    +abclo(3,m,nkvec,lo,iintsp)*ud%dulos(lo,ntyp,isp) ))
165 166 167
                            ENDIF
                      ENDDO
                   ENDIF
168 169 170 171 172 173 174
                   !--->             jump to the last matrixelement of the current row
                ENDIF
             END DO
          END DO
          !--->       calculate the hamiltonian matrix elements with other
          !--->       local orbitals at the same atom and with itself
          DO nkvec = 1,invsfct* (2*l+1)
175
             locol = lapw%nv(iintsp)+lapw%index_lo(lo,na)+nkvec !this is the column of the matrix
Daniel Wortmann's avatar
Daniel Wortmann committed
176 177
             IF (MOD(locol-1,mpi%n_size).EQ.mpi%n_rank) THEN
                locol=(locol-1)/mpi%n_size+1 !this is the column in local storage
178 179 180 181 182 183
                !-t3e
                !--->          calculate the hamiltonian matrix elements with other
                !--->          local orbitals at the same atom, if they have the same l
                DO lop = 1, (lo-1)
                   lp = atoms%llo(lop,ntyp)
                   DO nkvecp = 1,invsfct* (2*lp+1)
184
                      lorow=lapw%nv(jintsp)+lapw%index_lo(lop,na)+nkvecp
185 186 187 188
                      DO m = -l,l
                         lm = l* (l+1) + m
                         DO mp = -lp,lp
                            lmp = lp* (lp+1) + mp
Daniel Wortmann's avatar
Daniel Wortmann committed
189
                            in = tlmplm%ind(lmp,lm,ntyp,isp)
190 191
                            IF (in.NE.-9999) THEN
                               IF (in.GE.0) THEN
Daniel Wortmann's avatar
Daniel Wortmann committed
192 193 194 195
                                  utu = tlmplm%tuu(in,ntyp,isp)
                                  dtu = tlmplm%tdu(in,ntyp,isp)
                                  utd = tlmplm%tud(in,ntyp,isp)
                                  dtd = tlmplm%tdd(in,ntyp,isp)
196 197
                               ELSE
                                  im = -in
Daniel Wortmann's avatar
Daniel Wortmann committed
198 199 200 201
                                  utu = CONJG(tlmplm%tuu(im,ntyp,isp))
                                  dtu = CONJG(tlmplm%tud(im,ntyp,isp))
                                  utd = CONJG(tlmplm%tdu(im,ntyp,isp))
                                  dtd = CONJG(tlmplm%tdd(im,ntyp,isp))
202
                               END IF
Daniel Wortmann's avatar
Daniel Wortmann committed
203 204 205 206
                               utulo = tlmplm%tuulo(lmp,m,lo+mlo,isp)
                               dtulo = tlmplm%tdulo(lmp,m,lo+mlo,isp)
                               ulotu=CONJG(tlmplm%tuulo(lm,mp,lop+mlo,isp))
                               ulotd=CONJG(tlmplm%tdulo(lm,mp,lop+mlo,isp))
207 208
                               !--->                         note that lo > lop
                               lolop = ((lo-1)*lo)/2 + lop
Daniel Wortmann's avatar
Daniel Wortmann committed
209 210 211 212 213 214 215
                               ulotulo = CONJG(tlmplm%tuloulo (m,mp,lolop+mlolo,isp))
                               axx=CONJG(abclo(1,m,nkvec,lo,iintsp))*utu +&
                                    CONJG(abclo(2,m,nkvec,lo,iintsp))*utd +&
                                    CONJG(abclo(3,m,nkvec,lo,iintsp))*utulo
                               bxx=CONJG(abclo(1,m,nkvec,lo,iintsp))*dtu +&
                                    CONJG(abclo(2,m,nkvec,lo,iintsp))*dtd +&
                                    CONJG(abclo(3,m,nkvec,lo,iintsp))*dtulo
216
                               cxx = &
Daniel Wortmann's avatar
Daniel Wortmann committed
217 218 219 220 221 222 223 224 225 226 227
                                    CONJG(abclo(1,m,nkvec,lo,iintsp))*ulotu +&
                                    CONJG(abclo(2,m,nkvec,lo,iintsp))*ulotd +&
                                    CONJG(abclo(3,m,nkvec,lo,iintsp))*ulotulo
                               IF (hmat%l_real) THEN
                                  hmat%data_r(lorow,locol) = hmat%data_r(lorow,locol) + chi*invsfct * (&
                                       REAL(abclo(1,mp,nkvecp,lop,jintsp))* REAL(axx) -&
                                       AIMAG(abclo(1,mp,nkvecp,lop,jintsp))*AIMAG(axx) +&
                                       REAL(abclo(2,mp,nkvecp,lop,jintsp))* REAL(bxx) -&
                                       AIMAG(abclo(2,mp,nkvecp,lop,jintsp))*AIMAG(bxx) +&
                                       REAL(abclo(3,mp,nkvecp,lop,jintsp))* REAL(cxx) -&
                                       AIMAG(abclo(3,mp,nkvecp,lop,jintsp))*AIMAG(cxx) )
228
                               ELSE
Daniel Wortmann's avatar
Daniel Wortmann committed
229 230 231 232
                                  hmat%data_c(lorow,locol) = hmat%data_c(lorow,locol) + chi*invsfct * CONJG(&
                                       abclo(1,mp,nkvecp,lop,jintsp) * axx +&
                                       abclo(2,mp,nkvecp,lop,jintsp) * bxx +&
                                       abclo(3,mp,nkvecp,lop,jintsp) * cxx )
233 234 235 236 237 238 239 240 241
                               ENDIF
                            END IF
                         END DO
                      END DO
                   END DO
                END DO
                !--->          calculate the hamiltonian matrix elements of one local
                !--->          orbital with itself
                DO nkvecp = 1,nkvec
242
                   lorow=lapw%nv(jintsp)+lapw%index_lo(lop,na)+nkvecp
243 244 245 246
                   DO m = -l,l
                      lm = l* (l+1) + m
                      DO mp = -l,l
                         lmp = l* (l+1) + mp
Daniel Wortmann's avatar
Daniel Wortmann committed
247
                         in = tlmplm%ind(lmp,lm,ntyp,isp)
248 249
                         IF (in.NE.-9999) THEN
                            IF (in.GE.0) THEN
Daniel Wortmann's avatar
Daniel Wortmann committed
250 251 252 253
                               utu = tlmplm%tuu(in,ntyp,isp)
                               dtu = tlmplm%tdu(in,ntyp,isp)
                               utd = tlmplm%tud(in,ntyp,isp)
                               dtd = tlmplm%tdd(in,ntyp,isp)
254 255
                            ELSE
                               im = -in
Daniel Wortmann's avatar
Daniel Wortmann committed
256 257 258 259
                               utu = CONJG(tlmplm%tuu(im,ntyp,isp))
                               dtu = CONJG(tlmplm%tud(im,ntyp,isp))
                               utd = CONJG(tlmplm%tdu(im,ntyp,isp))
                               dtd = CONJG(tlmplm%tdd(im,ntyp,isp))
260
                            END IF
Daniel Wortmann's avatar
Daniel Wortmann committed
261 262 263 264
                            utulo = tlmplm%tuulo(lmp,m,lo+mlo,isp)
                            dtulo = tlmplm%tdulo(lmp,m,lo+mlo,isp)
                            ulotu = CONJG(tlmplm%tuulo(lm,mp,lo+mlo,isp))
                            ulotd = CONJG(tlmplm%tdulo(lm,mp,lo+mlo,isp))
265
                            lolo = ((lo-1)*lo)/2 + lo
Daniel Wortmann's avatar
Daniel Wortmann committed
266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283
                            ulotulo =CONJG(tlmplm%tuloulo(m,mp,lolo+mlolo,isp))
                            axx = CONJG(abclo(1,m,nkvec,lo,iintsp))*utu +&
                                 CONJG(abclo(2,m,nkvec,lo,iintsp))*utd +&
                                 CONJG(abclo(3,m,nkvec,lo,iintsp))*utulo
                            bxx = CONJG(abclo(1,m,nkvec,lo,iintsp))*dtu +&
                                 CONJG(abclo(2,m,nkvec,lo,iintsp))*dtd +&
                                 CONJG(abclo(3,m,nkvec,lo,iintsp))*dtulo
                            cxx = CONJG(abclo(1,m,nkvec,lo,iintsp))*ulotu +&
                                 CONJG(abclo(2,m,nkvec,lo,iintsp))*ulotd +&
                                 CONJG(abclo(3,m,nkvec,lo,iintsp))*ulotulo
                            IF (hmat%l_real) THEN
                               hmat%data_r(lorow,locol) = hmat%data_r(lorow,locol) + chi*invsfct* (&
                                    REAL(abclo(1,mp,nkvecp,lo,jintsp))* REAL(axx) -&
                                    AIMAG(abclo(1,mp,nkvecp,lo,jintsp))*AIMAG(axx) +&
                                    REAL(abclo(2,mp,nkvecp,lo,jintsp))* REAL(bxx) -&
                                    AIMAG(abclo(2,mp,nkvecp,lo,jintsp))*AIMAG(bxx) +&
                                    REAL(abclo(3,mp,nkvecp,lo,jintsp))* REAL(cxx) -&
                                    AIMAG(abclo(3,mp,nkvecp,lo,jintsp))*AIMAG(cxx) )
284
                            ELSE
Daniel Wortmann's avatar
Daniel Wortmann committed
285 286 287 288
                               hmat%data_c(lorow,locol) = hmat%data_c(lorow,locol) + chi*invsfct* CONJG(&
                                    abclo(1,mp,nkvecp,lo,jintsp)*axx +&
                                    abclo(2,mp,nkvecp,lo,jintsp)*bxx +&
                                    abclo(3,mp,nkvecp,lo,jintsp)*cxx )
289 290 291 292 293 294 295 296 297
                            ENDIF
                         END IF
                      END DO
                   END DO
                END DO
             ENDIF
             !-t3e
          END DO
       END DO ! end of lo = 1,atoms%nlo loop
Daniel Wortmann's avatar
Daniel Wortmann committed
298
   
299 300 301 302 303
    END IF
    !$OMP END MASTER
    !$OMP barrier
  END SUBROUTINE hlomat
      END MODULE m_hlomat