hlomat.F90 16.1 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) :: jintsp,iintsp
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
    
    !-->              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))
60
    DO i=MIN(jintsp,iintsp),MAX(jintsp,iintsp)
61
       CALL hsmt_ab(sym,atoms,noco,isp,i,ntyp,na,cell,lapw,fj,gj,ab(:,:),ab_size,.TRUE.,abclo(:,:,:,:,i),alo1,blo1,clo1)
Daniel Wortmann's avatar
Daniel Wortmann committed
62
    ENDDO
63

Daniel Wortmann's avatar
Daniel Wortmann committed
64
    
65 66 67 68 69 70 71 72
    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
Matthias Redies's avatar
Matthias Redies committed
73
    IF ((atoms%invsat(na) == 0) .OR. (atoms%invsat(na) == 1)) THEN
74 75 76 77 78 79
       !--->    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).
Matthias Redies's avatar
Matthias Redies committed
80 81
       IF (atoms%invsat(na) == 0) invsfct = 1
       IF (atoms%invsat(na) == 1) invsfct = 2
82
       !
Daniel Wortmann's avatar
Daniel Wortmann committed
83
    
84 85 86 87 88 89
       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
90
             DO kp = 1,lapw%nv(iintsp)
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
                   IF (lmp==lm) in=(lm* (lm+3))/2
100 101
                   IF (in.NE.-9999) THEN
                      IF (in.GE.0) THEN
Daniel Wortmann's avatar
Daniel Wortmann committed
102 103 104 105
                         utu = tlmplm%tuu(in,ntyp,isp)
                         dtu = tlmplm%tdu(in,ntyp,isp)
                         utd = tlmplm%tud(in,ntyp,isp)
                         dtd = tlmplm%tdd(in,ntyp,isp)
106 107
                      ELSE
                         im = -in
Daniel Wortmann's avatar
Daniel Wortmann committed
108 109 110 111
                         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))
112
                      END IF
Daniel Wortmann's avatar
Daniel Wortmann committed
113 114
                      utulo = tlmplm%tuulo(lmp,m,lo+mlo,isp)
                      dtulo = tlmplm%tdulo(lmp,m,lo+mlo,isp)
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
119
                      DO kp = 1,lapw%nv(iintsp)
Daniel Wortmann's avatar
Daniel Wortmann committed
120 121 122
                         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
123 124 125 126 127 128
                      END DO
                   END IF
                END DO
             END DO
             !+t3e
             DO nkvec = 1,invsfct* (2*l+1)
129
               locol= lapw%nv(jintsp)+lapw%index_lo(lo,na)+nkvec !this is the column of the matrix
Matthias Redies's avatar
Matthias Redies committed
130
                IF (MOD(locol-1,mpi%n_size) == mpi%n_rank) THEN
Daniel Wortmann's avatar
Daniel Wortmann committed
131
                   locol=(locol-1)/mpi%n_size+1 !this is the column in local storage
132
                   !-t3e
Daniel Wortmann's avatar
Daniel Wortmann committed
133
                   IF (hmat%l_real) THEN
134
                      DO kp = 1,lapw%nv(iintsp)
Daniel Wortmann's avatar
Daniel Wortmann committed
135
                         hmat%data_r(kp,locol) = hmat%data_r(kp,locol) + chi*invsfct * (&
136 137 138 139 140 141
                              REAL(abclo(1,m,nkvec,lo,jintsp))* REAL(ax(kp)) +&
                              AIMAG(abclo(1,m,nkvec,lo,jintsp))*AIMAG(ax(kp)) +&
                              REAL(abclo(2,m,nkvec,lo,jintsp))* REAL(bx(kp)) +&
                              AIMAG(abclo(2,m,nkvec,lo,jintsp))*AIMAG(bx(kp)) +&
                              REAL(abclo(3,m,nkvec,lo,jintsp))* REAL(cx(kp)) +&
                              AIMAG(abclo(3,m,nkvec,lo,jintsp))*AIMAG(cx(kp)) )
142 143
                         IF (input%l_useapw) THEN
                            !---> APWlo
Daniel Wortmann's avatar
Daniel Wortmann committed
144 145 146
                            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))*&
147 148 149
                                 (abclo(1,m,nkvec,lo,jintsp)*  ud%dus(l,ntyp,isp)&
                                 +abclo(2,m,nkvec,lo,jintsp)* ud%duds(l,ntyp,isp)&
                                 +abclo(3,m,nkvec,lo,jintsp)*ud%dulos(lo,ntyp,isp) ))
150
                         ENDIF
151 152
                      ENDDO
                   ELSE
153
                      DO kp = 1,lapw%nv(iintsp)
Daniel Wortmann's avatar
Daniel Wortmann committed
154
                            hmat%data_c(kp,locol) = hmat%data_c(kp,locol) + chi*invsfct * (&
155 156 157
                                 abclo(1,m,nkvec,lo,jintsp) * CONJG( ax(kp) ) +&
                                 abclo(2,m,nkvec,lo,jintsp) * CONJG( bx(kp) ) +&
                                 abclo(3,m,nkvec,lo,jintsp) * CONJG( cx(kp) ) )
158 159
                            IF (input%l_useapw) THEN
                               !---> APWlo
Daniel Wortmann's avatar
Daniel Wortmann committed
160 161 162
                               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))*&
163 164 165
                                    (abclo(1,m,nkvec,lo,jintsp)*  ud%dus(l,ntyp,isp)&
                                    +abclo(2,m,nkvec,lo,jintsp)* ud%duds(l,ntyp,isp)&
                                    +abclo(3,m,nkvec,lo,jintsp)*ud%dulos(lo,ntyp,isp) ))
166 167 168
                            ENDIF
                      ENDDO
                   ENDIF
169 170 171 172 173 174 175
                   !--->             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)
176
             locol = lapw%nv(jintsp)+lapw%index_lo(lo,na)+nkvec !this is the column of the matrix
Matthias Redies's avatar
Matthias Redies committed
177
             IF (MOD(locol-1,mpi%n_size) == mpi%n_rank) THEN
Daniel Wortmann's avatar
Daniel Wortmann committed
178
                locol=(locol-1)/mpi%n_size+1 !this is the column in local storage
179 180 181 182 183 184
                !-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)
185
                      lorow=lapw%nv(iintsp)+lapw%index_lo(lop,na)+nkvecp
186 187 188 189
                      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
190
                            in = tlmplm%ind(lmp,lm,ntyp,isp)
191
                            IF (lmp==lm) in=(lm* (lm+3))/2
192 193
                            IF (in.NE.-9999) THEN
                               IF (in.GE.0) THEN
Daniel Wortmann's avatar
Daniel Wortmann committed
194 195 196 197
                                  utu = tlmplm%tuu(in,ntyp,isp)
                                  dtu = tlmplm%tdu(in,ntyp,isp)
                                  utd = tlmplm%tud(in,ntyp,isp)
                                  dtd = tlmplm%tdd(in,ntyp,isp)
198 199
                               ELSE
                                  im = -in
Daniel Wortmann's avatar
Daniel Wortmann committed
200 201 202 203
                                  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))
204
                               END IF
Daniel Wortmann's avatar
Daniel Wortmann committed
205 206 207 208
                               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))
209 210
                               !--->                         note that lo > lop
                               lolop = ((lo-1)*lo)/2 + lop
Daniel Wortmann's avatar
Daniel Wortmann committed
211
                               ulotulo = CONJG(tlmplm%tuloulo (m,mp,lolop+mlolo,isp))
212 213 214 215 216 217
                               axx=CONJG(abclo(1,m,nkvec,lo,jintsp))*utu +&
                                    CONJG(abclo(2,m,nkvec,lo,jintsp))*utd +&
                                    CONJG(abclo(3,m,nkvec,lo,jintsp))*utulo
                               bxx=CONJG(abclo(1,m,nkvec,lo,jintsp))*dtu +&
                                    CONJG(abclo(2,m,nkvec,lo,jintsp))*dtd +&
                                    CONJG(abclo(3,m,nkvec,lo,jintsp))*dtulo
218
                               cxx = &
219 220 221
                                    CONJG(abclo(1,m,nkvec,lo,jintsp))*ulotu +&
                                    CONJG(abclo(2,m,nkvec,lo,jintsp))*ulotd +&
                                    CONJG(abclo(3,m,nkvec,lo,jintsp))*ulotulo
Daniel Wortmann's avatar
Daniel Wortmann committed
222 223
                               IF (hmat%l_real) THEN
                                  hmat%data_r(lorow,locol) = hmat%data_r(lorow,locol) + chi*invsfct * (&
224 225 226 227 228 229
                                       REAL(abclo(1,mp,nkvecp,lop,iintsp))* REAL(axx) -&
                                       AIMAG(abclo(1,mp,nkvecp,lop,iintsp))*AIMAG(axx) +&
                                       REAL(abclo(2,mp,nkvecp,lop,iintsp))* REAL(bxx) -&
                                       AIMAG(abclo(2,mp,nkvecp,lop,iintsp))*AIMAG(bxx) +&
                                       REAL(abclo(3,mp,nkvecp,lop,iintsp))* REAL(cxx) -&
                                       AIMAG(abclo(3,mp,nkvecp,lop,iintsp))*AIMAG(cxx) )
230
                               ELSE
Daniel Wortmann's avatar
Daniel Wortmann committed
231
                                  hmat%data_c(lorow,locol) = hmat%data_c(lorow,locol) + chi*invsfct * CONJG(&
232 233 234
                                       abclo(1,mp,nkvecp,lop,iintsp) * axx +&
                                       abclo(2,mp,nkvecp,lop,iintsp) * bxx +&
                                       abclo(3,mp,nkvecp,lop,iintsp) * cxx )
235 236 237 238 239 240 241 242 243
                               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
244
                   lorow=lapw%nv(iintsp)+lapw%index_lo(lop,na)+nkvecp
245 246 247 248
                   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
249
                         in = tlmplm%ind(lmp,lm,ntyp,isp)
250
                         IF (lmp==lm) in=(lm* (lm+3))/2
251 252
                         IF (in.NE.-9999) THEN
                            IF (in.GE.0) THEN
Daniel Wortmann's avatar
Daniel Wortmann committed
253 254 255 256
                               utu = tlmplm%tuu(in,ntyp,isp)
                               dtu = tlmplm%tdu(in,ntyp,isp)
                               utd = tlmplm%tud(in,ntyp,isp)
                               dtd = tlmplm%tdd(in,ntyp,isp)
257 258
                            ELSE
                               im = -in
Daniel Wortmann's avatar
Daniel Wortmann committed
259 260 261 262
                               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))
263
                            END IF
Daniel Wortmann's avatar
Daniel Wortmann committed
264 265 266 267
                            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))
268
                            lolo = ((lo-1)*lo)/2 + lo
Daniel Wortmann's avatar
Daniel Wortmann committed
269
                            ulotulo =CONJG(tlmplm%tuloulo(m,mp,lolo+mlolo,isp))
270 271 272 273 274 275 276 277 278
                            axx = CONJG(abclo(1,m,nkvec,lo,jintsp))*utu +&
                                 CONJG(abclo(2,m,nkvec,lo,jintsp))*utd +&
                                 CONJG(abclo(3,m,nkvec,lo,jintsp))*utulo
                            bxx = CONJG(abclo(1,m,nkvec,lo,jintsp))*dtu +&
                                 CONJG(abclo(2,m,nkvec,lo,jintsp))*dtd +&
                                 CONJG(abclo(3,m,nkvec,lo,jintsp))*dtulo
                            cxx = CONJG(abclo(1,m,nkvec,lo,jintsp))*ulotu +&
                                 CONJG(abclo(2,m,nkvec,lo,jintsp))*ulotd +&
                                 CONJG(abclo(3,m,nkvec,lo,jintsp))*ulotulo
Daniel Wortmann's avatar
Daniel Wortmann committed
279 280
                            IF (hmat%l_real) THEN
                               hmat%data_r(lorow,locol) = hmat%data_r(lorow,locol) + chi*invsfct* (&
281 282 283 284 285 286
                                    REAL(abclo(1,mp,nkvecp,lo,iintsp))* REAL(axx) -&
                                    AIMAG(abclo(1,mp,nkvecp,lo,iintsp))*AIMAG(axx) +&
                                    REAL(abclo(2,mp,nkvecp,lo,iintsp))* REAL(bxx) -&
                                    AIMAG(abclo(2,mp,nkvecp,lo,iintsp))*AIMAG(bxx) +&
                                    REAL(abclo(3,mp,nkvecp,lo,iintsp))* REAL(cxx) -&
                                    AIMAG(abclo(3,mp,nkvecp,lo,iintsp))*AIMAG(cxx) )
287
                            ELSE
Daniel Wortmann's avatar
Daniel Wortmann committed
288
                               hmat%data_c(lorow,locol) = hmat%data_c(lorow,locol) + chi*invsfct* CONJG(&
289 290 291
                                    abclo(1,mp,nkvecp,lo,iintsp)*axx +&
                                    abclo(2,mp,nkvecp,lo,iintsp)*bxx +&
                                    abclo(3,mp,nkvecp,lo,iintsp)*cxx )
292 293 294 295 296 297 298 299 300
                            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
301
   
302 303 304 305 306
    END IF
    !$OMP END MASTER
    !$OMP barrier
  END SUBROUTINE hlomat
      END MODULE m_hlomat