LCOV - code coverage report
Current view: top level - force - force_a21_lo.f90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 5 46 10.9 %
Date: 2019-09-08 04:53:50 Functions: 1 1 100.0 %

          Line data    Source code
       1             : !--------------------------------------------------------------------------------
       2             : ! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
       3             : ! This file is part of FLEUR and available as free software under the conditions
       4             : ! of the MIT license as expressed in the LICENSE file in more detail.
       5             : !--------------------------------------------------------------------------------
       6             : 
       7             : MODULE m_forcea21lo
       8             : CONTAINS
       9          48 :   SUBROUTINE force_a21_lo(atoms,isp,itype,we,eig,ne,eigVecCoeffs,&
      10          24 :                           aveccof,bveccof,cveccof,tlmplm,usdus,a21)
      11             :     !
      12             :     !***********************************************************************
      13             :     ! This subroutine calculates the local orbital contribution to A21,
      14             :     ! which is the combination of the terms A17 and A20 according to the
      15             :     ! paper of R.Yu et al. (PRB vol.43 no.8 p.64111991).
      16             :     ! p.kurz nov. 1997
      17             :     !***********************************************************************
      18             :     !
      19             :     USE m_types_setup
      20             :     USE m_types_usdus
      21             :     USE m_types_tlmplm
      22             :     USE m_types_cdnval
      23             :     IMPLICIT NONE
      24             :     TYPE(t_usdus),INTENT(IN)        :: usdus
      25             :     TYPE(t_tlmplm),INTENT(IN)       :: tlmplm
      26             :     TYPE(t_atoms),INTENT(IN)        :: atoms
      27             :     TYPE(t_eigVecCoeffs),INTENT(IN) :: eigVecCoeffs
      28             :     !     ..
      29             :     !     .. Scalar Arguments ..
      30             :     INTEGER, INTENT (IN) :: itype,ne,isp
      31             :     !     ..
      32             :     !     .. Array Arguments ..
      33             :     REAL,    INTENT(IN)    :: we(ne),eig(:)!(dimension%neigd)
      34             :     REAL,    INTENT(INOUT) :: a21(3,atoms%nat)
      35             :     COMPLEX, INTENT(IN)    :: aveccof(3,ne,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat)
      36             :     COMPLEX, INTENT(IN)    :: bveccof(3,ne,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat)
      37             :     COMPLEX, INTENT(IN)    :: cveccof(3,-atoms%llod:atoms%llod,ne,atoms%nlod,atoms%nat)
      38             :     !     ..
      39             :     !     .. Local Scalars ..
      40             :     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             :     !*************** ABBREVIATIONS *****************************************
      45             :     ! ccof       : coefficient of the local orbital function (u_lo*Y_lm)
      46             :     ! cveccof    : is defined equivalently to aveccof, but with the LO-fct.
      47             :     ! tuulo,tdulo and tuloulo are the MT hamiltonian matrix elements of the
      48             :     ! local orbitals with the flapw basisfct. and with themselves.
      49             :     ! for information on nlo,llo,nlol,lo1l,uulon,dulon, and uloulopn see
      50             :     ! comments in setlomap.
      51             :     !***********************************************************************
      52             : 
      53          24 :     DO lo = 1,atoms%nlo(itype)
      54           0 :        lo1=SUM(atoms%nlo(:itype-1))+lo
      55           0 :        l = atoms%llo(lo,itype)
      56          24 :        DO m = -l,l
      57           0 :           lm = l* (l+1) + m
      58           0 :           DO lp = 0,atoms%lmax(itype)
      59           0 :              DO mp = -lp,lp
      60           0 :                 lmp = lp* (lp+1) + mp
      61           0 :                 DO iatom = sum(atoms%neq(:itype-1))+1,sum(atoms%neq(:itype))
      62             :                    !
      63             :                    !--->             check whether the t-matrixelement is 0
      64             :                    !--->             (indmat.EQ.-9999)
      65             :                    !
      66           0 :                    in = tlmplm%ind(lmp,lm,itype,1)
      67           0 :                    IF ((in.NE.-9999).OR.(lmp.EQ.lm)) THEN
      68           0 :                       utulo = tlmplm%tuulo(lmp,m,lo1,1)
      69           0 :                       dtulo = tlmplm%tdulo(lmp,m,lo1,1)
      70           0 :                       cutulo = conjg(tlmplm%tuulo(lmp,m,lo1,1))
      71           0 :                       cdtulo = conjg(tlmplm%tdulo(lmp,m,lo1,1))
      72           0 :                       DO ie = 1,ne
      73           0 :                          DO i = 1,3
      74             :                             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           0 :                                  )*we(ie)/atoms%neq(itype)
      84             :                          ENDDO
      85             :                       ENDDO
      86             :                    ENDIF
      87             :                 ENDDO
      88             : 
      89             :              ENDDO
      90             :           ENDDO
      91           0 :           DO lop = 1,atoms%nlo(itype)
      92           0 :              lp = atoms%llo(lop,itype)
      93           0 :              DO mp = -lp,lp
      94           0 :                 lmp = lp* (lp+1) + mp
      95           0 :                 DO iatom = sum(atoms%neq(:itype-1))+1,sum(atoms%neq(:itype))
      96           0 :                    in = tlmplm%ind(lmp,lm,itype,1)
      97           0 :                    IF ((in.NE.-9999).OR.(lmp.EQ.lm)) THEN
      98           0 :                       lolop=DOT_PRODUCT(atoms%nlo(:itype-1),atoms%nlo(:itype-1)+1)/2
      99           0 :                       IF (lo.GE.lop) THEN
     100           0 :                          lolop = (lo-1)*lo/2 + lop + lolop
     101           0 :                          ulotulo = tlmplm%tuloulo(m,mp,lolop,1)
     102             :                       ELSE
     103           0 :                          loplo = (lop-1)*lop/2 + lo +lolop
     104           0 :                          ulotulo = conjg(tlmplm%tuloulo(mp,m,loplo,1))
     105             :                       ENDIF
     106           0 :                       DO ie = 1,ne
     107           0 :                          DO i = 1,3
     108             :                             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           0 :                                  )*we(ie)/atoms%neq(itype)
     112             :                          ENDDO
     113             :                       ENDDO
     114             :                    ENDIF
     115             :                 ENDDO
     116             :              ENDDO
     117             :           ENDDO
     118           0 :           DO iatom = sum(atoms%neq(:itype-1))+1,sum(atoms%neq(:itype))
     119           0 :              DO ie = 1,ne
     120           0 :                 DO i = 1,3
     121             :                    a21(i,iatom)=a21(i,iatom)&
     122             :                         -2.0*aimag(&
     123             :                         (conjg(eigVecCoeffs%acof(ie,lm,iatom,isp))*cveccof(i,m,ie,lo,iatom)+&
     124             :                         conjg(eigVecCoeffs%ccof(m,ie,lo,iatom,isp))*aveccof(i,ie,lm,iatom))*usdus%uulon(lo,itype,isp)+&
     125             :                         (conjg(eigVecCoeffs%bcof(ie,lm,iatom,isp))*cveccof(i,m,ie,lo,iatom)+&
     126             :                         conjg(eigVecCoeffs%ccof(m,ie,lo,iatom,isp))*bveccof(i,ie,lm,iatom))*&
     127           0 :                         usdus%dulon(lo,itype,isp))*eig(ie)*we(ie)/atoms%neq(itype)
     128             :                 ENDDO
     129             :              ENDDO
     130             :           ENDDO
     131             :           !--->       consider only the lop with l_lop = l_lo
     132           0 :           DO lop = atoms%lo1l(l,itype),(atoms%lo1l(l,itype)+atoms%nlol(l,itype)-1)
     133           0 :              DO iatom = sum(atoms%neq(:itype-1))+1,sum(atoms%neq(:itype))
     134           0 :                 DO ie = 1,ne
     135           0 :                    DO i = 1,3
     136             :                       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             :                            usdus%uloulopn(lo,lop,itype,isp))*&
     140           0 :                            eig(ie)*we(ie)/atoms%neq(itype)
     141             : 
     142             :                    ENDDO
     143             :                 ENDDO
     144             :              ENDDO
     145             :           ENDDO
     146             :           !--->    end of m loop
     147             :        ENDDO
     148             :        !---> end of lo loop
     149             :     ENDDO
     150             : 
     151          24 :   END SUBROUTINE force_a21_lo
     152             : END MODULE m_forcea21lo

Generated by: LCOV version 1.13