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

          Line data    Source code
       1             : MODULE m_forcea21U
       2             : CONTAINS
       3          24 :   SUBROUTINE force_a21_U(atoms,i_u,itype,isp,we,ne,usdus,v_mmp,eigVecCoeffs,aveccof,bveccof,cveccof,a21)
       4             :     !
       5             :     !***********************************************************************
       6             :     ! This subroutine calculates the lda+U contribution to the HF forces, 
       7             :     ! similar to the A21 term, according to eqn. (22) of F. Tran et al.
       8             :     ! Comp.Phys.Comm. 179 (2008) 784-790
       9             :     !***********************************************************************
      10             :     !
      11             :     USE m_constants
      12             :     USE m_types_setup
      13             :     USE m_types_usdus
      14             :     USE m_types_cdnval
      15             :     IMPLICIT NONE
      16             : 
      17             :     TYPE(t_usdus),INTENT(IN)        :: usdus
      18             :     TYPE(t_atoms),INTENT(IN)        :: atoms
      19             :     TYPE(t_eigVecCoeffs),INTENT(IN) :: eigVecCoeffs
      20             :     !     ..
      21             :     !     .. Scalar Arguments ..
      22             :     INTEGER, INTENT (IN)    :: itype,isp,ne
      23             :     INTEGER, INTENT (INOUT) :: i_u ! on input: index for the first U for atom type "itype or higher"
      24             :                                    ! on exit: index for the first U for atom type "itype+1 or higher"
      25             :     !     ..
      26             :     !     .. Array Arguments ..
      27             :     REAL,    INTENT(IN)    :: we(ne) 
      28             :     COMPLEX, INTENT(IN)    :: v_mmp(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,atoms%n_u)
      29             :     COMPLEX, INTENT(IN)    :: aveccof(3,ne,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat)
      30             :     COMPLEX, INTENT(IN)    :: bveccof(3,ne,0:atoms%lmaxd*(atoms%lmaxd+2),atoms%nat)
      31             :     COMPLEX, INTENT(IN)    :: cveccof(3,-atoms%llod:atoms%llod,ne,atoms%nlod,atoms%nat)
      32             :     REAL,    INTENT(INOUT) :: a21(3,atoms%nat)
      33             :     !     ..
      34             :     !     .. Local Scalars ..
      35             :     COMPLEX v_a,v_b,v_c,p1,p2,p3
      36             :     INTEGER lo,lop,l,lp ,mp,lm,lmp,iatom,ie,i,m
      37             :     !     ..
      38             :     !     ..
      39             :     !*************** ABBREVIATIONS *****************************************
      40             :     ! ccof       : coefficient of the local orbital function (u_lo*Y_lm)
      41             :     ! cveccof    : is defined equivalently to aveccof, but with the LO-fct.
      42             :     ! for information on nlo,llo,uulon,dulon, and uloulopn see
      43             :     ! comments in setlomap.
      44             :     !***********************************************************************
      45             : 
      46          24 :     IF (atoms%lda_u(i_u)%atomType.GT.itype) RETURN
      47             : 
      48          60 :     DO WHILE (atoms%lda_u(i_u)%atomType.EQ.itype)
      49             : 
      50          48 :        l = atoms%lda_u(i_u)%l
      51             : 
      52             :        !
      53             :        ! Add contribution for the regular LAPWs (like force_a21, but with
      54             :        ! the potential matrix, v_mmp, instead of the tuu, tdd ...)
      55             :        !
      56         240 :        DO m = -l,l
      57         192 :           lm = l* (l+1) + m
      58        1056 :           DO mp = -l,l
      59         816 :              lmp = l* (l+1) + mp
      60         816 :              v_a = v_mmp(m,mp,i_u) 
      61         816 :              v_b = v_mmp(m,mp,i_u) * usdus%ddn(l,itype,isp) 
      62        1824 :              DO iatom = sum(atoms%neq(:itype-1))+1,sum(atoms%neq(:itype))
      63       24480 :                 DO ie = 1,ne
      64       80784 :                    DO i = 1,3
      65       34272 :                       p1 = (CONJG(eigVecCoeffs%acof(ie,lm,iatom,isp)) * v_a) * aveccof(i,ie,lmp,iatom)
      66       34272 :                       p2 = (CONJG(eigVecCoeffs%bcof(ie,lm,iatom,isp)) * v_b) * bveccof(i,ie,lmp,iatom) 
      67       45696 :                       a21(i,iatom) = a21(i,iatom) + 2.0*AIMAG(p1 + p2) * we(ie)/atoms%neq(itype)
      68             :                    END DO
      69             :                 END DO
      70             :              END DO
      71             :           END DO ! mp
      72             :        END DO   ! m
      73             : 
      74             :        !
      75             :        ! If there are also LOs on this atom, with the same l as
      76             :        ! the one of LDA+U, add another few terms
      77             :        !
      78          48 :        DO lo = 1,atoms%nlo(itype)
      79          48 :           IF (l == atoms%llo(lo,itype)) THEN
      80           0 :              DO m = -l,l
      81           0 :                 lm = l* (l+1) + m
      82           0 :                 DO mp = -l,l
      83           0 :                    lmp = l* (l+1) + mp
      84           0 :                    v_a = v_mmp(m,mp,i_u)
      85           0 :                    v_b = v_mmp(m,mp,i_u) * usdus%uulon(lo,itype,isp)
      86           0 :                    v_c = v_mmp(m,mp,i_u) * usdus%dulon(lo,itype,isp)
      87           0 :                    DO iatom =  sum(atoms%neq(:itype-1))+1,sum(atoms%neq(:itype))
      88           0 :                       DO ie = 1,ne
      89           0 :                          DO i = 1,3
      90           0 :                             p1 = v_a * (CONJG(eigVecCoeffs%ccof(m,ie,lo,iatom,isp)) * cveccof(i,mp,ie,lo,iatom))
      91             :                             p2 = v_b * (CONJG(eigVecCoeffs%acof(ie,lm,iatom,isp)) * cveccof(i,mp,ie,lo,iatom) + &
      92           0 :                                         CONJG(eigVecCoeffs%ccof(m,ie,lo,iatom,isp)) * aveccof(i,ie,lmp,iatom))
      93             :                             p3 = v_c * (CONJG(eigVecCoeffs%bcof(ie,lm,iatom,isp)) * cveccof(i,mp,ie,lo,iatom) + &
      94           0 :                                         CONJG(eigVecCoeffs%ccof(m,ie,lo,iatom,isp)) * bveccof(i,ie,lmp,iatom))
      95           0 :                             a21(i,iatom) = a21(i,iatom) + 2.0*AIMAG(p1 + p2 + p3)*we(ie)/atoms%neq(itype)
      96             :                          END DO
      97             :                       END DO
      98             :                    END DO
      99             :                 END DO
     100             :              END DO
     101             :           END IF   ! l == atoms%llo(lo,itype)
     102             :        END DO     ! lo = 1,atoms%nlo
     103             : 
     104          48 :        i_u = i_u + 1
     105          48 :        IF(i_u.GT.atoms%n_u) EXIT
     106             :     END DO
     107             : 
     108             :   END SUBROUTINE force_a21_U
     109             : END MODULE m_forcea21U

Generated by: LCOV version 1.13